Changeset 861 for LATMOS-Accounts/lib
- Timestamp:
- 12/02/11 11:42:17 (13 years ago)
- Location:
- LATMOS-Accounts/lib/LATMOS
- Files:
-
- 24 added
- 33 edited
Legend:
- Unmodified
- Added
- Removed
-
LATMOS-Accounts/lib/LATMOS/Accounts.pm
r684 r861 21 21 =cut 22 22 23 sub _configdir { 24 my ($self) = @_; 25 ($self || {})->{_configdir} || '/etc/latmos-accounts' 26 } 27 23 28 =head1 FUNCTION 24 29 25 =head2 new($config file)30 =head2 new($configdir) 26 31 27 32 Instanciate a new LATMOS::Accounts object. 28 33 29 $config file if defined is the Config::IniFiles formatted fileto use,30 default to F</etc/latmos-account .ini>.34 $configdir if defined is the directory containing files to use, 35 default to F</etc/latmos-accounts/>. 31 36 32 37 =cut … … 35 40 my ($class, $config, %options) = @_; 36 41 37 $config ||= '/etc/latmos-account.ini'; 42 $config ||= _configdir(); 43 my $oldconfig ||= '/etc/latmos-account.ini'; 44 45 # If config file not found, fallback to old one 46 my $configfile = -f join('/', $config, 'latmos-accounts.ini') 47 ? join('/', $config, 'latmos-accounts.ini') 48 : '/etc/latmos-account.ini'; 38 49 39 50 my $self = Config::IniFiles->new( 40 -file => $config ,51 -file => $configfile, 41 52 '-default' => '_default_', 42 ); 43 if ((!$options{noacl}) && $self->val('_default_', 'acls')) { 44 my $acls = LATMOS::Accounts::Acls->new( 45 $self->val('_default_', 'acls') 46 ) or do { 47 return; 48 }; 49 $self->{_acls} = $acls; 53 ) or do { 54 la_log(LA_ERR, 'Can\'t open main config file %s', $configfile); 55 return; 56 }; 57 58 $self->{_configdir} = $config; 59 bless($self, $class); 60 61 if (!$options{noacl}) { 62 if ($self->val('_default_', 'acls')) { 63 $self->{_acls} = LATMOS::Accounts::Acls->new( 64 $self->val('_default_', 'acls') 65 ) or do { 66 la_log(LA_ERR, 67 'Cannot load ACL file %s', $self->val('_default_', 'acls') 68 ); 69 return; 70 }; 71 } elsif (-f (my $aclf = join('/', $self->_configdir, 'la-acls.ini'))) { 72 $self->{_acls} = LATMOS::Accounts::Acls->new($aclf) or do { 73 la_log(LA_ERR, 'Cannot load ACL file %s', $aclf); 74 return; 75 }; 76 } 50 77 } 51 78 … … 53 80 $self->{_allowed_values} = Config::IniFiles->new( 54 81 -file => $self->val('_default_', 'allowed_values'), 55 -allowempty => 1,56 82 ) or do { 83 la_log(LA_ERR, 'Cannot load ALLOWED VALUES %s', 84 $self->val('_default_', 'allowed_values')); 57 85 return; 58 86 }; 59 } 60 61 bless($self, $class) 87 } elsif (-f (my $allowf = join('/', $self->_configdir, 88 'la-allowed-values.ini'))) { 89 $self->{_allowed_values} = Config::IniFiles->new( 90 -file => $allowf, 91 ) or do { 92 la_log(LA_ERR, 'Cannot load ALLOWED VALUES %s', $allowf); 93 return; 94 }; 95 } 96 97 $self 62 98 } 63 99 … … 153 189 acls => $self->{_acls}, 154 190 allowed_values => $self->{_allowed_values}, 191 configdir => $self->_configdir, 155 192 ) or do { 156 193 la_log(LA_WARN, "Cannot instanciate base $section ($type)"); -
LATMOS-Accounts/lib/LATMOS/Accounts/Bases.pm
r856 r861 67 67 } 68 68 69 =head2 log($level, $msg, $arg) 70 71 Log a message prefixed by database information 72 73 =cut 74 69 75 sub log { 70 76 my ($self, $level, $msg, @args) = @_; … … 73 79 } 74 80 81 =head2 label 82 83 Return the database label 84 85 =cut 86 75 87 sub label { 76 88 $_[0]->{_label} || 'NoLabel'; … … 81 93 } 82 94 83 sub allowed_values { 84 $_[0]->{_allowed_values} 85 } 86 87 sub obj_attr_allowed_values { 88 my ($self, $otype, $attr) = @_; 89 if ($self->allowed_values) { 90 return $self->allowed_values->val("$otype.$attr", 'allowed'); 91 } 92 return(); 93 } 94 95 sub check_allowed_values { 96 my ($self, $otype, $attr, $attrvalues) = @_; 97 $self->allowed_values or return 1; 98 my @values = ref $attrvalues ? @{ $attrvalues } : $attrvalues; 99 foreach my $value (@values) { 100 $value or next; 101 if (my @allowed = $self->allowed_values->val("$otype.$attr", 'allowed')) { 102 grep { $value eq $_ } @allowed or do { 103 $self->log(LA_ERR, 104 "value `%s' is not allow for %s.%s per configuration (allowed_values)", 105 $value, $otype, $attr 106 ); 107 return; 108 }; 109 } 110 } 111 return 1; 112 } 113 114 sub _load_obj_class { 115 my ($self, $otype) = @_; 116 117 # finding perl class: 118 my $pclass = ref $self; 119 $pclass .= '::' . ucfirst(lc($otype)); 120 eval "require $pclass;"; 121 if ($@) { 122 $self->log(LA_DEBUG, 'Cannot load perl class %s', $pclass); 123 return 124 } # error message ? 125 return $pclass; 126 } 127 128 =head2 list_canonical_fields($otype, $for) 129 130 Return the list of supported fields by the database for object type $otype. 131 132 Optionnal $for specify the goal for which the list is requested, only supported 133 fields will be returns 134 135 =cut 136 137 sub list_canonical_fields { 138 my ($self, $otype, $for) = @_; 139 $for ||= 'rw'; 140 my $pclass = $self->_load_obj_class($otype) or return; 141 sort $pclass->_canonical_fields($self, $for); 142 } 143 144 sub get_attr_schema { 145 my ($self, $otype, $attribute) = @_; 146 my $pclass = $self->_load_obj_class($otype) or return; 147 if ($pclass->can('_get_attr_schema')) { 148 my $info = $pclass->_get_attr_schema($self, $attribute); 149 return $info if ($info); 150 } 151 if ($self->can('_get_attr_schema')) { 152 my $info = $self->_get_attr_schema($otype, $attribute); 153 return $info if($info); 154 } 155 return {} 156 } 157 158 sub attribute { 159 my ($self, $otype, $attribute) = @_; 160 return LATMOS::Accounts::Bases::Attributes->new( 161 $attribute, 162 $self, 163 $otype, 164 ); 165 } 166 167 sub delayed_fields { 168 my ($self, $otype, $for) = @_; 169 $for ||= 'rw'; 170 my $pclass = $self->_load_obj_class($otype) or return; 171 $pclass->_delayed_fields($self, $for); 172 } 173 174 =head2 get_field_name($otype, $c_fields, $for) 175 176 Return the internal fields name for $otype object for 177 canonical fields $c_fields 178 179 =cut 180 181 sub get_field_name { 182 my ($self, $otype, $c_fields, $for) = @_; 183 $for ||= 'rw'; 184 my $pclass = $self->_load_obj_class($otype) or return; 185 $pclass->_get_field_name($c_fields, $self, $for); 95 sub options { 96 my ($self, $opt) = @_; 97 return $self->{_options}{$opt}; 186 98 } 187 99 … … 212 124 } 213 125 126 sub ordered_objects { 127 my ($self) = @_; 128 129 my %deps; 130 my %maxdeps; 131 my @objs = sort { $b cmp $a } $self->list_supported_objects; 132 foreach my $obj (@objs) { 133 foreach my $at ($self->list_canonical_fields($obj)) { 134 my $attr = $self->attribute($obj, $at); 135 $attr->ro and next; 136 $attr->{delayed} and next; 137 if (my $res = $attr->reference) { 138 $deps{$obj}{$res} ||= 1; 139 if ($attr->mandatory) { 140 $deps{$obj}{$res} = 2; 141 $maxdeps{$res} = 1; 142 } 143 } 144 } 145 } 146 147 sort { 148 if (keys %{$deps{$a} || {}}) { 149 if (keys %{$deps{$b} || {}}) { 150 return ( 151 ($deps{$a}{$b} || 0) > ($deps{$b}{$a} || 0) ? 1 : 152 ($deps{$b}{$a} || 0) > ($deps{$a}{$b} || 0) ? -1 : 153 ($maxdeps{$b} || 0) - ($maxdeps{$a} || 0) 154 ); 155 } else { 156 return 1; 157 } 158 } elsif (keys %{$deps{$b} || {}}) { 159 return -1; 160 } else { 161 return ($maxdeps{$b} || 0) - ($maxdeps{$a} || 0) 162 } 163 } @objs; 164 } 165 166 sub _load_obj_class { 167 my ($self, $otype) = @_; 168 169 # finding perl class: 170 my $pclass = ref $self; 171 $pclass .= '::' . ucfirst(lc($otype)); 172 eval "require $pclass;"; 173 if ($@) { 174 $self->log(LA_DEBUG, 'Cannot load perl class %s', $pclass); 175 return 176 } # error message ? 177 return $pclass; 178 } 179 180 214 181 =head2 is_supported_object($otype) 215 182 … … 259 226 sub create_object { 260 227 my ($self, $otype, $id, %data) = @_; 228 "$id" or do { 229 $self->log(LA_ERR, "Cannot create %s object with empty id", 230 $otype); 231 return; 232 }; 261 233 my $pclass = $self->_load_obj_class($otype); 262 234 if ($pclass->_create($self, $id, %data)) { … … 289 261 return; 290 262 }; 291 if (my $chk = (lc($otype) eq 'user' || lc($otype) eq 'group') 263 264 $self->_create_c_object($otype, $id, %cdata); 265 } 266 267 sub _create_c_object { 268 my ($self, $otype, $id, %cdata) = @_; 269 270 if (my $chk = ( 271 lc($otype) eq 'user' || lc($otype) eq 'group') 292 272 ? LATMOS::Accounts::Utils::check_ug_validity($id) 293 273 : LATMOS::Accounts::Utils::check_oid_validity($id)) { … … 301 281 }; 302 282 } 303 304 $self->_create_c_object($otype, $id, %cdata);305 }306 307 sub _create_c_object {308 my ($self, $otype, $id, %cdata) = @_;309 283 310 284 # populating default value … … 324 298 to_ascii(lc($cdata{sn})),) 325 299 : undef; 300 $mailid =~ s/\s*//g if($mailid); 326 301 327 302 if ($mailid && 328 303 $self->is_supported_object('aliases') && 329 304 ! $self->get_object('aliases', $mailid)) { 330 if ( $self->get_field_name($otype, 'mail', 'write')) {331 if ( $self->{defattr}{'user.maildomain'}) {305 if (my $attr = $self->attribute($otype, 'mail')) { 306 if ((!$attr->ro) && $self->{defattr}{'user.maildomain'}) { 332 307 $cdata{mail} ||= sprintf('%s@%s', 333 308 $mailid, … … 335 310 } 336 311 } 337 if ( $self->get_field_name($otype, 'aliases', 'write')) {338 $cdata{aliases} ||= $mailid ;312 if (my $attr = $self->attribute($otype, 'aliases')) { 313 $cdata{aliases} ||= $mailid unless ($attr->ro); 339 314 } 340 if ( $self->get_field_name($otype, 'revaliases', 'write')) {341 $cdata{revaliases} ||= $mailid ;315 if (my $attr = $self->attribute($otype, 'revaliases')) { 316 $cdata{revaliases} ||= $mailid unless ($attr->ro); 342 317 } 343 318 } … … 348 323 my %data; 349 324 foreach my $cfield (keys %cdata) { 350 my $field = $self->get_field_name($otype, $cfield, 'write') or next; 351 $data{$field} = $cdata{$cfield}; 352 } 353 keys %data or return 0; # TODO: return an error ? 325 my $attribute = $self->attribute($otype, $cfield) or next; 326 $attribute->ro and next; 327 $data{$attribute->iname} = $cdata{$cfield}; 328 } 329 #keys %data or return 0; # TODO: return an error ? 354 330 $self->create_object($otype, $id, %data); 331 } 332 333 334 sub _allowed_values { 335 $_[0]->{_allowed_values} 336 } 337 338 sub obj_attr_allowed_values { 339 my ($self, $otype, $attr) = @_; 340 if ($self->_allowed_values && 341 $self->_allowed_values->SectionExists("$otype.$attr")) { 342 return grep { defined($_) } $self->_allowed_values->val("$otype.$attr", 'allowed'); 343 } 344 return(); 345 } 346 347 sub check_allowed_values { 348 my ($self, $otype, $attr, $attrvalues) = @_; 349 $self->_allowed_values or return 1; 350 my @values = ref $attrvalues ? @{ $attrvalues } : $attrvalues; 351 foreach my $value (@values) { 352 $value or next; 353 if (my @allowed = $self->obj_attr_allowed_values($otype, $attr)) { 354 grep { $value eq $_ } @allowed or do { 355 $self->log(LA_ERR, 356 "value `%s' is not allow for %s.%s per configuration (allowed_values)", 357 $value, $otype, $attr 358 ); 359 return; 360 }; 361 } 362 } 363 return 1; 364 } 365 366 =head2 list_canonical_fields($otype, $for) 367 368 Return the list of supported fields by the database for object type $otype. 369 370 Optionnal $for specify the goal for which the list is requested, only supported 371 fields will be returns 372 373 =cut 374 375 sub list_canonical_fields { 376 my ($self, $otype, $for) = @_; 377 $for ||= 'rw'; 378 my $pclass = $self->_load_obj_class($otype) or return; 379 sort $pclass->_canonical_fields($self, $for); 380 } 381 382 sub _get_attr_schema { 383 my ($self, $otype) = @_; 384 my $pclass = $self->_load_obj_class($otype) or return; 385 return $pclass->_get_attr_schema($self); 386 } 387 388 sub get_attr_schema { 389 my ($self, $otype, $attribute) = @_; 390 my $info = $self->_get_attr_schema($otype); 391 if ($info->{$attribute}) { 392 return $info->{$attribute}; 393 } else { 394 return; 395 } 396 } 397 398 sub attribute { 399 my ($self, $otype, $attribute) = @_; 400 return LATMOS::Accounts::Bases::Attributes->new( 401 $attribute, 402 $self, 403 $otype, 404 ); 405 } 406 407 sub delayed_fields { 408 my ($self, $otype, $for) = @_; 409 $self->log(LA_WARN, "calling DEPRECATED delayed_fields " . join(',', 410 caller)); 411 $for ||= 'rw'; 412 my @attrs; 413 foreach ($self->list_canonical_fields($otype, $for)) { 414 my $attr = $self->attribute($otype, $_) or next; 415 $for =~ /w/ && $attr->ro and next; 416 $attr->delayed or next; 417 push(@attrs, $_); 418 } 419 @attrs 420 } 421 422 sub ochelper { 423 my ($self, $otype) = @_; 424 my $pclass = ucfirst(lc($otype)); 425 foreach my $class ( 426 ref($self) . '::OCHelper::' . $pclass, 427 ref($self) . '::OCHelper', 428 "LATMOS::Accounts::Bases::OCHelper::$pclass", 429 'LATMOS::Accounts::Bases::OCHelper' ) { 430 eval "require $class;"; 431 if ($@) { next } # error message ? 432 my $ochelper = "$class"->new($self, $otype); 433 return $ochelper; 434 } 435 return; 355 436 } 356 437 … … 463 544 } 464 545 } 546 547 $self->postcommit(); 548 465 549 return 1; 550 } 551 552 sub postcommit { 553 my ($self) = @_; 554 555 if ($self->{_options}{postcommit}) { 556 exec_command($self->{_options}{postcommit}, 557 { 558 BASE => $self->label, 559 BASETYPE => $self->type, 560 HOOK_TYPE => 'POST', 561 CONFIG => $self->{_options}{configdir}, 562 } 563 ); 564 } else { 565 return 1; 566 } 466 567 } 467 568 … … 541 642 : $self->list_canonical_fields($srcobj->type, 'w'); 542 643 my %data; 543 my %delayed = map { $_ => 1 } $self->delayed_fields($srcobj->type);544 644 foreach (@fields) { 545 $srcobj->get_field_name($_, 'r') or next; 645 # check attribute exists in source: 646 my $attr = $srcobj->attribute($_) or next; 546 647 if (! $options{onepass}) { 547 648 if ($options{firstpass}) { 548 $ delayed{$_}and next;649 $attr->delayed and next; 549 650 } else { 550 $ delayed{$_}or next;651 $attr->delayed or next; 551 652 } 552 653 } 553 654 $data{$_} = $srcobj->_get_c_field($_); 554 655 } 555 keys %data or return '';556 656 if (my $dstobj = $self->get_object($srcobj->type, $srcobj->id)) { 657 keys %data or return 'SYNCED'; 658 foreach (keys %data) { 659 if (!$dstobj->attribute($_) || 660 $dstobj->attribute($_)->ro) { 661 delete($data{$_}); 662 } 663 } 557 664 my $res = $dstobj->_set_c_fields(%data); 558 665 if (defined $res) { … … 615 722 }; 616 723 617 if ($self-> get_field_name('user', 'exported', 'r')) {724 if ($self->attribute('user', 'exported')) { 618 725 if (!$uobj->_get_c_field('exported')) { 619 726 la_log(LA_ERR, "User $username found but currently unexported"); … … 622 729 } 623 730 624 if (my $expire = $uobj->_get_c_field('shadowExpire')) { 625 if ($expire > 0 && $expire < int(time / ( 3600 * 24 ))) { 626 la_log(LA_ERR, "Account $username has expired (%d / %d)", 627 $expire, int(time / ( 3600 * 24 ))); 628 return; 629 } 731 if ($uobj->_get_c_field('expired')) { 732 la_log(LA_ERR, "Account $username has expired (%s)", 733 $uobj->_get_c_field('expired')); 734 return; 630 735 } 631 736 -
LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Ad/Group.pm
r821 r861 42 42 sub _my_ldap_classes { qw(top group) } 43 43 44 sub _delayed_fields { 45 my ($self)= @_; 46 return qw(memberUID member managedBy); 47 } 48 49 sub _canonical_fields { 50 my ($self, $base, $mode) = @_; 51 ( 52 qw(gidNumber description member memberUID sAMAccountName managedBy), 53 ($mode !~ /w/ 54 ? qw(cn dn objectClass) 55 : () 56 ) 57 ) 44 sub _get_attr_schema { 45 my ($class, $base) = @_; 46 { 47 gidNumber => { uniq => 1, }, 48 description => { }, 49 member => { 50 delayed => 1, 51 can_values => sub { $base->list_objects('user') }, 52 }, 53 memberUID => { delayed => 1, }, 54 sAMAccountName => { }, 55 managedBy => { 56 delayed => 1, 57 can_values => sub { $base->list_objects('user') }, 58 }, 59 cn => { ro => 1, }, 60 dn => { ro => 1, }, 61 objectClass => { ro => 1, }, 62 msSFU30NisDomain => { }, 63 msSFU30Name => { }, 64 65 } 58 66 } 59 67 -
LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Ad/User.pm
r810 r861 43 43 sub _my_ldap_classes { qw(top person organizationalPerson user) } 44 44 45 sub _delayed_fields { 46 my ($self)= @_; 47 return qw(memberOf manager); 48 } 49 50 sub _canonical_fields { 51 my ($self, $base, $mode) = @_; 52 ( 53 qw( 54 sn name givenName 55 sAMAccountName uid gecos 56 homeDirectory loginShell 57 uidNumber gidNumber 58 shadowLastChange shadowMin shadowMax 59 shadowWarning shadowInactive shadowExpire 60 shadowFlag 61 description 62 mail 63 telephoneNumber 64 ipPhone otherTelephone department 65 title mobile homePhone 66 accountExpires 67 streetAddress postalCode postOfficeBox l 68 physicalDeliveryOfficeName 69 company st 70 displayName 71 initials 72 manager 73 userAccountControl 74 locked 75 memberOf 76 winhomeDirectory 77 facsimileTelephoneNumber 78 ), 79 ($mode !~ /w/ 80 ? qw(cn dn uSNCreated uSNChanged directReports objectClass) 81 : () 82 ) 83 ) 45 sub _get_attr_schema { 46 my ($class, $base) = @_; 47 { 48 sn => { }, 49 name => { }, 50 givenName => { }, 51 sAMAccountName => { }, 52 uid => { uniq => 1, }, 53 gecos => { }, 54 homeDirectory => { }, 55 loginShell => { }, 56 uidNumber => { uniq => 1, }, 57 gidNumber => { 58 mandatory => 1, 59 can_values => sub { 60 map { $base->get_object('group', 61 $_)->get_attributes('gidNumber') } 62 $base->list_objects('group') 63 }, 64 display => sub { 65 my ($self, $val) = @_; 66 my ($gr) = $self->base->search_objects('group', "gidNumber=$val") 67 or return; 68 return $gr; 69 }, 70 reference => 'group', 71 }, 72 shadowLastChange => { }, 73 shadowMin => { }, 74 shadowMax => { }, 75 shadowWarning => { }, 76 shadowInactive => { }, 77 shadowExpire => { }, 78 shadowFlag => { }, 79 description => { }, 80 mail => { }, 81 telephoneNumber => { }, 82 ipPhone => { }, 83 otherTelephone => { }, 84 department => { }, 85 title => { }, 86 mobile => { }, 87 homePhone => { }, 88 accountExpires => { }, 89 streetAddress => { }, 90 postalCode => { }, 91 postOfficeBox => { }, 92 l => { }, 93 physicalDeliveryOfficeName => { }, 94 company => { }, 95 st => { }, 96 displayName => { }, 97 initials => { }, 98 manager => { 99 delayed => 1, 100 can_values => sub { $base->list_objects('user') }, 101 }, 102 userAccountControl => { }, 103 locked => { }, 104 memberOf => { delayed => 1, }, 105 winhomeDirectory => { }, 106 facsimileTelephoneNumber => { }, 107 cn => { ro => 1, }, 108 dn => { ro => 1, }, 109 uSNCreated => { ro => 1, }, 110 uSNChanged => { ro => 1, }, 111 directReports => { ro => 1, }, 112 objectClass => { ro => 1, }, 113 msSFU30NisDomain => { }, 114 msSFU30Name => { }, 115 labeledURI => {}, 116 wWWHomePage => {}, 117 } 84 118 } 85 119 … … 206 240 }; 207 241 /^manager$/ && $value and do { 208 my $user = $base->get_object('user', $value) or next; 242 my $user = $base->get_object('user', $value) or do { 243 $value = undef; 244 next; 245 }; 209 246 $value = $user->get_field('dn'); 210 247 next; 211 248 }; 212 249 /^locked$/ and do { 213 my $uac = $entry->get_value('userAccountControl') ;250 my $uac = $entry->get_value('userAccountControl') || 0; 214 251 if ($value) { 215 252 $uac |= 0x00000002; -
LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Attributes.pm
r857 r861 25 25 : (undef, $base_or_object, $maybe_otype); 26 26 27 my $attr_info = $base->get_attr_schema($otype, $attributes) ;27 my $attr_info = $base->get_attr_schema($otype, $attributes) or return; 28 28 29 29 $attr_info->{_base} = $base; … … 38 38 sub name { $_[0]->{_name} } 39 39 sub otype { $_[0]->{_otype} } 40 sub mandatory { $_[0]->{mandatory} || 0 } 41 sub object { $_[0]->{_object} } 42 43 =head2 reference 44 45 A object type this attribute refer to 46 47 =cut 48 49 sub reference { 50 my ($self) = @_; 51 if ($self->{reference} && 52 $self->base->is_supported_object($self->{reference})) { 53 return $self->{reference}; 54 } else { 55 return; 56 } 57 } 40 58 41 59 =head2 … … 49 67 sub label { $_[0]->{label} || $_[0]->{_name} } 50 68 69 sub has_values_list { 70 my ($self) = @_; 71 if ($self->base->obj_attr_allowed_values( 72 $self->otype, 73 $self->name) || 74 $self->{can_values} || 75 $self->reference) { 76 return 1; 77 } else { 78 return 0; 79 } 80 } 81 51 82 sub can_values { 52 83 my ($self) = @_; … … 59 90 return @{$self->{can_values}}; 60 91 } elsif (ref $self->{can_values} eq 'CODE') { 61 $self->{can_values}->($self );92 $self->{can_values}->($self, $self->object); 62 93 } else { 63 94 return; 64 95 } 96 } elsif (my $ref = $self->reference) { 97 return $self->base->list_objects($ref); 65 98 } else { return } 66 99 } 67 100 68 sub ro { $_[0]->{ro} || 0 } 101 sub display { 102 my ($self, $value) = @_; 103 if ($self->{display}) { 104 return $self->{display}->($self, $value); 105 } else { 106 return $value; 107 } 108 } 109 110 sub input { 111 my ($self, $value) = @_; 112 if ($self->{input}) { 113 return $self->{input}->($value); 114 } else { 115 return $value; 116 } 117 } 118 119 sub ro { 120 my ($self) = @_; 121 if (ref $self->{ro} eq 'CODE') { 122 return $self->{ro}->($self->object) || 0; 123 } else { 124 return $_[0]->{ro} || 0 125 } 126 } 69 127 70 128 sub readonly { … … 72 130 return 1 if ($self->ro); 73 131 74 return ! $self->base->check_acl($self->object 75 ? ($self->object, $self->name, 'w') 76 : ($self->otype, '@CREATE', 'w')); 132 return ! $self->check_acl('w'); 133 } 134 135 sub check_acl { 136 my ($self, $mode) = @_; 137 return $self->base->check_acl($self->object 138 ? ($self->object, $self->name, $mode) 139 : ($self->otype, '@CREATE', $mode)); 77 140 } 78 141 79 142 =head2 form_type 80 143 81 Return the way the fields must be show in GUI: 144 Return the way the fields must be show in GUI. 145 For each type option maybe given by from_option 146 147 =head3 LABEL 82 148 83 149 =over 4 84 150 85 =item LABEL151 =item length 86 152 87 =item TEXT 153 The length to use to show the attribute 88 154 89 = item DATE155 =back 90 156 91 = item LIST157 =head3 TEXT 92 158 93 =item CHECKBOX 159 =head3 TEXTAREA 160 161 =head3 DATE 162 163 =head3 LIST 164 165 =head3 CHECKBOX 166 167 =over 4 168 169 =item rawvalue 170 171 The real value of the attribute must be show 94 172 95 173 =back … … 97 175 =cut 98 176 99 sub form_type { $_[0]->ro ? 'LABEL' : ($_[0]->{formtype} || 'TEXT') } 177 sub real_form_type { $_[0]->{formtype} || 'TEXT' } 178 179 sub form_type { 180 $_[0]->readonly ? 'LABEL' : 181 $_[0]->{formtype} ? $_[0]->{formtype} : 182 $_[0]->has_values_list ? 'LIST' : 183 $_[0]->real_form_type 184 } 185 186 sub form_option { 187 my ($self, $option) = @_; 188 return $self->{formopts}{$option} 189 } 100 190 101 191 sub uniq { $_[0]->{uniq} || 0 } … … 103 193 sub multiple { $_[0]->{multiple} || 0 } 104 194 195 sub hidden { $_[0]->{hide} || 0 } 196 197 sub delayed { $_[0]->{delayed} || 0 } 198 105 199 1; -
LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Dummy/User.pm
r679 r861 7 7 our $VERSION = (q$Rev$ =~ /^Rev: (\d+) /)[0]; 8 8 9 my %fields_map = ( 10 username => 'username', 11 homeDirectory => 'home', 12 ); 9 sub _get_attr_schema { 10 { 11 username => {}, 12 homeDirectory => { iname => 'home' }, 13 } 14 } 15 16 sub list { 17 return (); 18 } 13 19 14 20 sub new { … … 22 28 } 23 29 24 sub _canonical_fields {25 my ($self) = @_;26 return keys %fields_map;27 }28 29 sub _get_field_name {30 my ($self, $field) = @_;31 return $fields_map{$field};32 }33 34 30 1; -
LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Ldap/Group.pm
r766 r861 42 42 sub _my_ldap_classes { qw(top posixGroup) } 43 43 44 sub _delayed_fields { 45 my ($self)= @_; 46 return qw(memberUID); 47 } 48 49 sub _canonical_fields { 50 my ($self, $base, $mode) = @_; 51 ( 52 qw(gidNumber description memberUID), 53 ($mode !~ /w/ 54 ? qw(cn dn objectClass) 55 : () 56 ) 57 ) 44 sub _get_attr_schema { 45 my ($class, $base) = @_; 46 $class->SUPER::_get_attr_schema($base, 47 { 48 gidNumber => { uniq => 1, }, 49 description => { }, 50 memberUID => { multiple => 1, delayed => 1, }, 51 cn => { ro => 1 }, 52 dn => { ro => 1 }, 53 objectClass => { ro => 1 }, 54 } 55 ); 58 56 } 59 57 … … 69 67 $entry->replace(objectClass => [ $class->_my_ldap_classes ],); 70 68 my %delayed; 69 $data{cn} = $id; 71 70 foreach (keys %data) { 72 71 /^(memberUID)$/ and do { -
LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Ldap/Onlyaddress.pm
r678 r861 47 47 ) } 48 48 49 sub _delayed_fields { 50 my ($self)= @_; 51 return qw(); 52 } 53 54 sub _canonical_fields { 55 my ($self, $base, $mode) = @_; 56 ( 57 qw(displayName givenName 58 initials mail sn 59 mobile o uid facsimileTelephoneNumber), # inetOrgPerson 60 qw(street postOfficeBox postalCode postalAddress streetAddress 61 physicalDeliveryOfficeName ou st l telephoneNumber), # organizationalPerson 62 ($mode 63 !~ /w/ 64 ? qw(cn dn objectClass) 65 : () 66 ) 67 ) 49 sub _get_attr_schema { 50 my ($class, $base) = @_; 51 { 52 # inetOrgPerson 53 displayName => {}, 54 givenName => {}, 55 initials => {}, 56 mail => {}, 57 sn => {}, 58 mobile => {}, 59 o => {}, 60 uid => {}, 61 facsimileTelephoneNumber => {}, 62 # organizationalPerson 63 street => {}, 64 postOfficeBox => {}, 65 postalCode => {}, 66 postalAddress => {}, 67 streetAddress => {}, 68 physicalDeliveryOfficeName => {}, 69 ou => {}, 70 st => {}, 71 l => {}, 72 telephoneNumber => {}, 73 cn => { ro => 1 }, 74 dn => { ro => 1 }, 75 objectClass => { ro => 1 }, 76 } 68 77 } 69 78 … … 80 89 [ $class->_my_ldap_classes ],); 81 90 $data{sn} ||= $id; # sn is mandatory 91 $data{cn} = $id; 82 92 foreach (keys %data) { 83 93 $class->_populate_entry($entry, -
LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Ldap/User.pm
r767 r861 49 49 ) } 50 50 51 sub _delayed_fields { 52 my ($self)= @_; 53 return qw(memberOf manager); 54 } 55 56 sub _canonical_fields { 57 my ($self, $base, $mode) = @_; 58 ( 59 qw(displayName givenName homePhone homePostalAddress 60 initials mail sn 61 mobile o uid manager facsimileTelephoneNumber), # inetOrgPerson 62 qw(uidNumber gidNumber homeDirectory 63 userPassword loginShell 64 gecos description), # posixAccount 65 qw(shadowLastChange 66 shadowMin shadowMax 67 shadowWarning 68 shadowInactive 69 shadowExpire 70 shadowFlag), # shadowAccount 71 qw(street postOfficeBox postalCode postalAddress streetAddress 72 physicalDeliveryOfficeName ou st l telephoneNumber), # organizationalPerson 73 ('memberOf'), 74 ($mode 75 !~ /w/ 76 ? qw(cn dn objectClass) 77 : () 78 ) 79 ) 51 sub _get_attr_schema { 52 my ($class, $base) = @_; 53 $class->SUPER::_get_attr_schema($base, 54 { 55 displayName => { }, 56 givenName => { }, 57 homePhone => { }, 58 homePostalAddress => { }, 59 initials => { }, 60 mail => { }, 61 sn => { }, 62 mobile => { }, 63 o => { }, 64 uid => { }, 65 manager => { 66 delayed => 1, 67 can_values => sub { $base->list_objects('user') }, 68 }, 69 facsimileTelephoneNumber => { }, 70 uidNumber => { uniq => 1, }, 71 gidNumber => { 72 reference => 'group', 73 mandatory => 1, 74 can_values => sub { 75 map { $base->get_object('group', 76 $_)->get_attributes('gidNumber') } 77 $base->list_objects('group') 78 }, 79 display => sub { 80 my ($self, $val) = @_; 81 my ($gr) = $self->base->search_objects('group', "gidNumber=$val") 82 or return; 83 return $gr; 84 }, 85 86 }, 87 homeDirectory => { }, 88 userPassword => { }, 89 loginShell => { }, 90 gecos => { }, 91 description => { }, 92 shadowLastChange => { }, 93 shadowMin => { }, 94 shadowMax => { }, 95 shadowWarning => { }, 96 shadowInactive => { }, 97 shadowExpire => { }, 98 shadowFlag => { }, 99 street => { }, 100 postOfficeBox => { }, 101 postalCode => { }, 102 postalAddress => { }, 103 streetAddress => { }, 104 physicalDeliveryOfficeName => { }, 105 ou => { }, 106 st => { }, 107 l => { }, 108 telephoneNumber => { }, 109 memberOf => { delayed => 1, }, 110 111 cn => { ro => 1, }, 112 dn => { ro => 1, }, 113 objectClass => { ro => 1, }, 114 pwdAccountLockedTime => {}, 115 pwdPolicySubentry => {}, 116 pwdChangedTime => { ro => 1 }, 117 labeledURI => {}, 118 } 119 ); 80 120 } 81 121 … … 91 131 $entry->replace(objectClass => 92 132 [ $class->_my_ldap_classes ],); 133 $data{cn} = $id; 93 134 $data{sn} ||= $id; # sn is mandatory 94 135 $data{homeDirectory} ||= '/dev/null'; # homeDirectory is mandatory … … 153 194 $field eq 'manager' and do { 154 195 my $dn = $self->SUPER::get_field($field) or return; 155 return $self->base->_get_object_from_dn($dn)->get_value('cn'); 196 my $manager = $self->base->_get_object_from_dn($dn) or return; 197 return $manager->get_value('cn'); 156 198 }; 157 199 $self->SUPER::get_field($field); … … 195 237 }; 196 238 /^manager$/ && $val and do { 197 my $user = $base->get_object('user', $val) or 198 next; 239 my $user = $base->get_object('user', $val) or do { 240 $val = undef; 241 next; 242 }; 199 243 $val = $user->get_field('dn'); 200 244 next; -
LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Ldap/objects.pm
r715 r861 35 35 36 36 =cut 37 38 sub _get_attr_schema { 39 my ($class, $base, $info) = @_; 40 $info ||= {}; 41 42 foreach (qw( 43 createTimestamp 44 creatorsName 45 entryUUID 46 modifiersName 47 modifyTimestamp 48 entryCSN 49 )) { 50 $info->{$_} = { ro => 1 }; 51 } 52 53 return $info; 54 } 37 55 38 56 sub list { … … 59 77 } 60 78 61 sub _get_field_name {62 my ($self, $field, $base, $for) = @_;63 64 my %fields = map { $_ => 1 } $self->_canonical_fields($base, $for);65 66 return $fields{$field} ? $field : undef;67 }68 69 79 sub new { 70 80 my ($class, $base, $uid) = @_; … … 78 88 ), 79 89 base => $base->object_base_dn($class->type), 90 attrs => [ $class->_canonical_fields($base, 'r') ], 80 91 ); 81 92 … … 135 146 sub _populate_entry { 136 147 my ($self, $entry, $field, $value, $base) = @_; 137 my $val = $entry->get_value($field);148 my $val = ref $self ? $self->get_field($field) : undef; 138 149 my $tr = join(', ', map { $_ || '' } ($field, $val, $value)); 139 150 if ($value) { … … 159 170 } 160 171 foreach (keys %fields) { 161 $self->get_field_name($_, 'w') or next; 172 my $attr = $self->attribute($_) or do { 173 $self->base->log(LA_ERR, "Unknow attribute %s (%s)", 174 $_, $self->type); 175 return; 176 }; 177 $attr->ro and next; 162 178 $self->_populate_entry($self->{entry}, $_, $fields{$_}); 163 179 } -
LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Mail.pm
r817 r861 15 15 16 16 my $base = { 17 file => { 18 aliases => $options{aliases} || '/etc/aliases', 19 revaliases => $options{revaliases} || '/etc/revaliases', 20 }, 17 file => {}, 21 18 aliases => {}, 22 19 revaliases => {}, 23 20 }; 21 22 foreach (qw(aliases revaliases)) { 23 if ($options{$_}) { 24 $base->{file}{$_} = $options{$_}; 25 } elsif ($options{directory}) { 26 $base->{file}{$_} = $options{directory} . '/' . $_; 27 } else { 28 $base->{file}{$_} = "/etc/$_"; 29 } 30 } 31 24 32 25 33 bless($base, $class); -
LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Mail/Aliases.pm
r812 r861 16 16 } 17 17 18 sub _canonical_fields { 19 my ($self, $for) = @_; 20 return (qw(forward)); 21 } 22 23 sub _get_field_name { 24 my ($self, $c_field, $base, $for) = @_; 25 for ($c_field) { 26 /^forward$/ and last; 27 return; 18 sub _get_attr_schema { 19 my ($class, $base) = @_; 20 { 21 forward => {}, 28 22 } 29 return $c_field;30 23 } 31 24 -
LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Mail/Revaliases.pm
r351 r861 16 16 } 17 17 18 sub _canonical_fields { 19 my ($self, $for) = @_; 20 return (qw(as)); 21 } 22 23 sub _get_field_name { 24 my ($self, $c_field, $base, $for) = @_; 25 for ($c_field) { 26 /^as$/ and last; 27 return; 18 sub _get_attr_schema { 19 my ($class, $base) = @_; 20 { 21 as => {}, 28 22 } 29 return $c_field;30 23 } 31 24 -
LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Mail/objects.pm
r305 r861 9 9 our $VERSION = (q$Rev: 641 $ =~ /^Rev: (\d+) /)[0]; 10 10 11 #sub list_canonical_fields {12 # my ($self, $for) = @_;13 #} -
LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Objects.pm
r852 r861 126 126 sub list_canonical_fields { 127 127 my ($self, $for) = @_; 128 $self->base->list_canonical_fields($self->type, $for); 128 $for ||= 'rw'; 129 $self->_canonical_fields($for); 129 130 } 130 131 … … 137 138 } 138 139 139 =head2 get_field_name($field, $for) 140 141 Object shortcut to get the field name supported by the object. 142 143 =cut 144 145 sub get_field_name { 146 my ($self, $field, $for) = @_; 147 $self->base->get_field_name($self->type, $field, $for); 148 } 149 150 =head2 _canonical_fields 151 152 Must return the list of field supported by the object. 153 154 Notice this query will always come from the upstream data base, 155 this function is just a facility to store data in the module, but the 156 underling database can reply themself. 157 158 Is call if underling base doesn't override list_canonical_fields() 159 160 See list_canonical_fields(). 161 162 sub _canonical_fields { 163 my ($self) = @_; 164 } 165 166 =cut 167 168 sub _delayed_fields { 169 my ($self)= @_; 170 return (); 171 } 172 173 =head2 _get_fields_name($field, $for) 174 175 Return the fields name for canonical field $field. 176 $for, if set, is a string containing 'r' for read, 'w' for write, 177 depending usage context. 178 179 sub _get_field_name { 180 my ($self, $field, $for) = @_; 181 } 182 183 =cut 140 sub _canonical_fields { 141 my ($class, $base, $for) = @_; 142 $for ||= 'rw'; 143 my $info = $base->_get_attr_schema($class->type); 144 my @attrs = map { $base->attribute($class->type, $_) } keys %{$info || {}}; 145 @attrs = grep { ! $_->ro } @attrs if($for =~ /w/); 146 map { $_->name } grep { !$_->hidden } @attrs; 147 } 184 148 185 149 =head2 get_field($field) … … 197 161 Return the value for canonical field $cfield. 198 162 199 Call driver specific get_field _name() and get_field()163 Call driver specific get_field() 200 164 201 165 =cut … … 231 195 } 232 196 197 sub get_state { 198 my ($self, $state) = @_; 199 # hum... 200 if (defined(my $res = $self->_get_state($state))) { 201 return $res; 202 } 203 for ($state) { 204 } 205 return; 206 } 207 208 sub _get_state { 209 my ($self, $state) = @_; 210 return; 211 } 212 233 213 sub _get_c_field { 234 214 my ($self, $cfield) = @_; 235 215 my $return; 236 my $ field = $self->base->get_field_name($self->type, $cfield, 'r') or do {216 my $attribute = $self->attribute($cfield) or do { 237 217 $self->base->log(LA_WARN, "Unknow attribute $cfield"); 238 218 return; 239 219 }; 240 $return = $self->get_field($ field);220 $return = $self->get_field($attribute->iname); 241 221 } 242 222 … … 307 287 my %data; 308 288 foreach my $cfield (keys %cdata) { 309 my $ field = $self->base->get_field_name($self->type, $cfield, 'w') or do {289 my $attribute = $self->attribute($cfield) or do { 310 290 $self->base->log(LA_ERR, 311 291 "Cannot set unsupported attribute %s to %s (%s)", … … 314 294 return; 315 295 }; 316 $data{$field} = $cdata{$cfield}; 296 $attribute->ro and do { 297 $self->base->log(LA_ERR, 298 "Cannot set read-only attribute %s to %s (%s)", 299 $cfield, $self->id, $self->type 300 ); 301 return; 302 }; 303 $attribute->mandatory && 304 (!(defined($cdata{$cfield})) || $cdata{$cfield} eq '') and do { 305 $self->base->log(LA_ERR, 306 "%s attribute cannot be empty, ignoring for object %s/%s", 307 $cfield, 308 $self->type, 309 $self->id, 310 ); 311 return 0; 312 }; 313 if (ref $cdata{$cfield}) { 314 $data{$attribute->iname} = []; # ensure hash entry exists 315 foreach (@{$cdata{$cfield}}) { 316 push(@{$data{$attribute->iname}}, defined($_) 317 ? $attribute->input($_) 318 : undef 319 ); 320 } 321 } else { 322 $data{$attribute->iname} = defined($cdata{$cfield}) 323 ? $attribute->input($cdata{$cfield}) 324 : undef; 325 } 317 326 } 318 327 keys %data or return 0; # TODO: return an error ? … … 346 355 sub _set_password { 347 356 my ($self, $clear_pass) = @_; 348 if (my $ field = $self->base->get_field_name($self->type, 'userPassword')) {357 if (my $attribute = $self->base->attribute($self->type, 'userPassword')) { 349 358 my @salt_char = (('a' .. 'z'), ('A' .. 'Z'), (0 .. 9), '/', '.'); 350 359 my $salt = join('', map { $salt_char[rand(scalar(@salt_char))] } (1 .. 8)); 351 my $res = $self->set_fields($field, crypt($clear_pass, '$1$' . $salt)); 352 $self->base->log(LA_NOTICE, 'Mot de passe changé pour %s', $self->id); 360 my $res = $self->set_fields($attribute->iname, crypt($clear_pass, '$1$' . $salt)); 361 $self->base->log(LA_NOTICE, 'Mot de passe changé pour %s', $self->id) 362 if($res); 353 363 return $res; 354 364 } else { … … 390 400 my $match = 1; 391 401 foreach my $field (keys %parsed_filter) { 392 $base-> get_field_name($class->type, $field, 'r') or die393 "Unsupported attribute $field\n";402 $base->attribute($class->type, $field) or 403 la_log LA_WARN "Unsupported attribute $field"; 394 404 my $tmatch = 0; 395 405 foreach (@{$parsed_filter{$field}}) { … … 447 457 sub find_next_numeric_id { 448 458 my ($class, $base, $field, $min, $max) = @_; 449 $base-> get_field_name($class->type, $field) or return;459 $base->attribute($class->type, $field) or return; 450 460 $min ||= 451 461 $field eq 'uidNumber' ? 500 : … … 492 502 foreach my $attr (sort { $a cmp $b } $base->list_canonical_fields($otype, 493 503 $options->{only_rw} ? 'rw' : 'r')) { 494 my $ wok = $base->get_field_name($otype, $attr, 'w');504 my $oattr = $base->attribute($otype, $attr); 495 505 if (ref $self) { 496 506 my $val = $self->get_c_field($attr); 497 507 if ($val || $options->{empty_attr}) { 498 508 if (my @allowed = $base->obj_attr_allowed_values($otype, $attr)) { 499 $dump .= sprintf("# %s must be empty or either: %s\n",509 $dump .= sprintf("# %s must be%s: %s\n", 500 510 $attr, 511 ($oattr->mandatory ? '' : ' empty or either'), 501 512 join(', ', @allowed) 502 513 ); … … 507 518 s/\r?\n/\\n/g; 508 519 $dump .= sprintf("%s%s:%s\n", 509 $ wok ? '' : '# (ro)',520 $oattr->ro ? '# (ro) ' : '', 510 521 $attr, $_ ? " $_" : ''); 511 522 } … … 519 530 } 520 531 $dump .= sprintf("%s%s: %s\n", 521 $ wok ? '' : '# (ro)',532 $oattr->ro ? '# (ro) ' : '', 522 533 $attr, ''); 523 534 } -
LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Sql.pm
r850 r861 8 8 use LATMOS::Accounts::Log; 9 9 use DBI; 10 use Crypt::RSA; 11 use Crypt::RSA::Key::Public::SSH; 12 use Crypt::RSA::Key::Private::SSH; 13 use MIME::Base64; 10 14 11 15 our $VERSION = (q$Rev$ =~ /^Rev: (\d+) /)[0]; … … 64 68 undef, undef, 65 69 { 66 RaiseError => 1,70 RaiseError => 0, 67 71 AutoCommit => 0, 68 72 PrintWarn => 1, … … 70 74 } 71 75 ) or do { 72 $self->log(LA_ERR, "Cannot connect to database ");76 $self->log(LA_ERR, "Cannot connect to database: %s", $DBI::errstr); 73 77 return; 74 78 }; … … 92 96 } 93 97 94 sub commit {98 sub _commit { 95 99 my ($self) = @_; 96 100 if ($ENV{LA_NO_COMMIT}) { … … 104 108 } 105 109 106 sub rollback {110 sub _rollback { 107 111 my ($self) = @_; 108 112 if ($ENV{LA_NO_COMMIT}) { … … 131 135 return ($res->{max}); 132 136 } 137 138 139 # Extra non standard functions 133 140 134 141 sub get_global_value { … … 156 163 }; 157 164 } 165 166 sub generate_rsa_key { 167 my ($self, $password) = @_; 168 169 my $rsa = new Crypt::RSA ES => 'PKCS1v15'; 170 my ($public, $private) = $rsa->keygen ( 171 Identity => 'LATMOS-Accounts', 172 Size => 768, 173 Password => $password, 174 Verbosity => 0, 175 KF=>'SSH', 176 ) or die $rsa->errstr(); # TODO avoid die 177 return ($public, $private); 178 } 179 180 sub private_key { 181 my ($self, $password) = @_; 182 my $base = $self; 183 my $serialize = $base->get_global_value('rsa_private_key') or return; 184 my $privkey = Crypt::RSA::Key::Private::SSH->new; 185 $privkey->deserialize(String => [ decode_base64($serialize) ], 186 Passphrase => $password); 187 $privkey 188 } 189 190 sub get_rsa_password { 191 my ($self) = @_; 192 my $base = $self; 193 my $sth = $base->db->prepare(q{ 194 select "name", value from "user" join user_attributes_base 195 on "user".ikey = user_attributes_base.okey 196 where user_attributes_base.attr = 'encryptedPassword' 197 }); 198 $sth->execute; 199 my %users; 200 while (my $res = $sth->fetchrow_hashref) { 201 $users{$res->{name}} = $res->{value}; 202 } 203 %users 204 } 205 206 sub store_rsa_key { 207 my ($self, $public, $private) = @_; 208 my $base = $self; 209 $base->set_global_value('rsa_private_key', 210 encode_base64($private->serialize)); 211 $base->set_global_value('rsa_public_key', 212 $public->serialize); 213 return; 214 } 215 158 216 159 217 sub find_next_expire_users { … … 196 254 } 197 255 256 sub rename_nethost { 257 my ($self, $nethostname, $to, %options) = @_; 258 { 259 my $obj = $self->get_object('nethost', $nethostname); 260 my @cname = grep { $_ && $_ ne $to} 261 $obj->get_attributes('cname'); 262 $obj->set_c_fields(cname => [ @cname ]) or return; 263 } 264 $self->rename_object('nethost', $nethostname, $to) or return; 265 if ($options{'addcname'}) { 266 my $obj = $self->get_object('nethost', $to); 267 my @cname = grep { $_ } $obj->get_attributes('cname'); 268 $obj->set_c_fields(cname => [ @cname, $nethostname ]); 269 } 270 return 1; 271 } 272 273 sub nethost_exchange_ip { 274 my ($self, $ip1, $ip2) = @_; 275 my ($obj1, $obj2); 276 if (my ($host1) = $self->search_objects('nethost', "ip=$ip1")) { 277 $obj1 = $self->get_object('nethost', $host1); 278 } else { 279 $self->la_log(LA_ERR, "Cannot find host having $ip1"); 280 return; 281 } 282 if (my ($host2) = $self->search_objects('nethost', "ip=$ip2")) { 283 $obj2 = $self->get_object('nethost', $host2); 284 } else { 285 $self->la_log(LA_ERR, "Cannot find host having $ip2"); 286 return; 287 } 288 if ($obj1->id eq $obj2->id) { 289 $self->la_log(LA_ERR, "Both ip belong to same host (%s)", $obj1->id); 290 return; 291 } 292 293 my @ip1 = grep { $_ && $_ ne $ip1 } $obj1->get_attributes('ip'); 294 $obj1->set_c_fields(ip => [ @ip1 ]); 295 my @ip2 = grep { $_ && $_ ne $ip2 } $obj2->get_attributes('ip'); 296 $obj2->set_c_fields(ip => [ @ip2, $ip1 ]) or return; 297 $obj1->set_c_fields(ip => [ @ip1, $ip2 ]) or return; 298 return 1; 299 } 300 301 sub register_attribute { 302 my ($self, $otype, $attribute, $comment) = @_; 303 my $pclass = $self->_load_obj_class($otype) or return; 304 $pclass->register_attribute($self, $attribute, $comment); 305 } 306 307 sub get_attribute_comment { 308 my ($self, $otype, $attribute) = @_; 309 my $pclass = $self->_load_obj_class($otype) or return; 310 $pclass->get_attribute_comment($self, $attribute); 311 } 312 313 sub set_attribute_comment { 314 my ($self, $otype, $attribute, $comment) = @_; 315 my $pclass = $self->_load_obj_class($otype) or return; 316 $pclass->set_attribute_comment($self, $attribute, $comment); 317 } 318 198 319 1; 199 320 -
LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Sql/Address.pm
r809 r861 43 43 sub has_extended_attributes { 1 } 44 44 45 sub _ inline_fields{46 my ($ self, $for, $base) = @_;45 sub _get_attr_schema { 46 my ($class, $base) = @_; 47 47 48 my %fields = ( 49 name => 'name', 50 exported => 'exported', 51 user => 'user', 48 $class->SUPER::_get_attr_schema($base, 49 { 50 name => { inline => 1, }, 51 exported => { inline => 1, }, 52 user => { inline => 1, 53 reference => 'user', 54 }, 55 site => { 56 reference => 'site', 57 }, 58 sn => { ro => 1, }, 59 mail => { ro => 1, }, 60 givenName => { ro => 1, }, 61 postalAddress => { ro => 1, }, 62 displayName => { ro => 1, }, 63 co => { 64 ro => sub { $_[0] && $_[0]->get_attributes('site') ? 1 : 0 }, 65 }, 66 l => { 67 ro => sub { $_[0] && $_[0]->get_attributes('site') ? 1 : 0 }, 68 }, 69 postalCode => { 70 ro => sub { $_[0] && $_[0]->get_attributes('site') ? 1 : 0 }, 71 }, 72 streetAddress => { 73 formtype => 'TEXTAREA', 74 ro => sub { $_[0] && $_[0]->get_attributes('site') ? 1 : 0 }, 75 }, 76 postOfficeBox => { 77 ro => sub { $_[0] && $_[0]->get_attributes('site') ? 1 : 0 }, 78 }, 79 st => { 80 ro => sub { $_[0] && $_[0]->get_attributes('site') ? 1 : 0 }, 81 }, 82 facsimileTelephoneNumber => { 83 ro => sub { $_[0] && $_[0]->get_attributes('site') ? 1 : 0 }, 84 }, 85 o => { 86 ro => sub { $_[0] && $_[0]->get_attributes('site') ? 1 : 0 }, 87 }, 88 isMainAddress => { formtype => 'CHECKBOX', }, 89 } 52 90 ); 53 %fields54 }55 56 sub _managed_fields {57 my ($self, $for, $base) = @_;58 (site => 'site'),59 $for !~ /w/ ? (60 sn => 'sn',61 mail => 'mail',62 givenName => 'givenName',63 postalAddress => 'postalAddress',64 displayName => 'displayName',65 ) : ()66 }67 68 sub _delayed_fields {69 my ($self)= @_;70 return qw();71 91 } 72 92 … … 75 95 $data{user} or return; 76 96 my $user = $base->get_object('user', $data{user}); 97 $user or return; 77 98 if (!$user->get_c_field('otheraddress')) { 78 99 $data{isMainAddress} = 1; … … 83 104 sub get_field { 84 105 my ($self, $field) = @_; 85 if ((grep { $field eq $_ } __PACKAGE__->_address_fields()) 86 && (my $fsite = $self->get_c_field('site'))) { 106 if ((grep { $field eq $_ } (qw( 107 co l 108 postalCode streetAddress 109 postOfficeBox st 110 facsimileTelephoneNumber o 111 ))) && (my $fsite = $self->get_c_field('site'))) { 87 112 my $site = $self->base->get_object('site', $fsite); 88 113 if ($site) { … … 90 115 } 91 116 } elsif ($field =~ /^(sn|givenName|mail)$/) { 92 my $user = $self->base->get_object('user', $self->_get_c_field('user')); 117 my $user = $self->base->get_object('user', $self->_get_c_field('user')) 118 or return; 93 119 return $user->_get_c_field($field); 94 120 } elsif ($field eq 'postalAddress' ) { … … 125 151 $data{$attr}); 126 152 if ($site) { 127 foreach (__PACKAGE__->_address_fields()) { 153 foreach (qw(co l postalCode streetAddress postOfficeBox st 154 facsimileTelephoneNumber o)) { 128 155 $fdata{$_} = undef; 129 156 $data{$_} = undef; -
LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Sql/Aliases.pm
r499 r861 42 42 sub key_field { 'name' } 43 43 44 sub has_extended_attributes { 0}44 sub has_extended_attributes { 1 } 45 45 46 sub _managed_fields { 47 my ($class, $for, $base) = @_; 48 return( 49 $for !~ /w/ 50 ? ( 51 finalpoint => 'finalpoint', 52 parents => 'parents', 53 anyparents => 'anyparents', 54 sameforward => 'sameforward', 55 samedestination => 'samedestination', 56 ) 57 : () 58 ); 46 sub _get_attr_schema { 47 my ($class, $base) = @_; 48 49 $class->SUPER::_get_attr_schema($base, 50 { 51 name => { 52 ro => 1, 53 }, 54 forward => { 55 mandatory => 1, 56 multiple => 1, 57 }, 58 finalpoint => { ro => 1, }, 59 parents => { ro => 1, }, 60 anyparents => { ro => 1, }, 61 sameforward => { ro => 1, }, 62 samedestination => { ro => 1, }, 63 user => { 64 ro => 1, 65 reference => 'user', 66 }, 67 } 68 ) 59 69 } 60 70 -
LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Sql/Group.pm
r768 r861 44 44 sub has_extended_attributes { 1 } 45 45 46 sub _inline_fields { 47 my ($self, $for, $base) = @_; 48 return ( 49 gidNumber => 'gidnumber', 50 exported => 'exported', 51 ($for !~ /w/) ? ( 52 name => 'name', 53 cn => 'name', 54 create => 'create', 55 date => 'date', 56 ) : (), 57 ); 58 } 46 sub _get_attr_schema { 47 my ($class, $base) = @_; 59 48 60 sub _managed_fields { 61 my ($self, $for, $base) = @_; 62 63 my %fields = ( 64 memberUID => 'memberUID', 65 member => 'member', 66 $for !~ /w/ ? ( 67 sAMAccountName => 'name', 68 groupname => 'name', 69 ) : (), 70 ); 71 %fields; 72 } 73 74 sub _delayed_fields { 75 my ($self)= @_; 76 return qw(memberUID member); 49 $class->SUPER::_get_attr_schema($base, 50 { 51 gidNumber => { inline => 1, uniq => 1, iname => 'gidnumber', 52 mandatory => 1, }, 53 gidnumber => { inline => 1, uniq => 1, hide => 1, }, 54 exported => { inline => 1, }, 55 name => { inline => 1, ro => 1 }, 56 cn => { inline => 1, ro => 1, iname => 'name', }, 57 create => { inline => 1, ro => 1 }, 58 date => { inline => 1, ro => 1 }, 59 memberUID => { 60 reference => 'user', 61 multiple => 1, 62 delayed => 1, 63 ro => sub { 64 $_[0] && 65 ($_[0]->_get_c_field('sutype') ||'') =~ /^(jobtype|contrattype)$/ 66 ? 1 : 0 67 }, 68 }, 69 member => { 70 reference => 'user', 71 multiple => 1, 72 delayed => 1, 73 can_values => sub { $base->list_objects('user') }, 74 ro => sub { 75 $_[0] && 76 ($_[0]->_get_c_field('sutype') ||'') =~ /^(jobtype|contrattype)$/ 77 ? 1 : 0 78 }, 79 }, 80 sAMAccountName => { iname => 'name', ro => 1 }, 81 groupname => { ro => 1 }, 82 managedBy => { 83 reference => 'user', 84 can_values => sub { 85 my %uniq = map { $_ => 1 } grep { $_ } 86 ($_[1] ? $_[1]->get_attributes('manager') : ()), 87 $base->search_objects('user', 'active=*'); 88 sort keys %uniq; 89 }, 90 }, 91 sutype => { 92 reference => 'sutype', 93 }, 94 } 95 ) 77 96 } 78 97 … … 130 149 $res++; 131 150 } elsif ($member{$_}{c}) { 151 if (($user->get_c_field('department') || '') eq $self->id) { 152 $self->base->log(LA_WARN, 153 "Don't removing user %s from group %s: is it's department", 154 $user->id, $self->id); 155 next; 156 } 132 157 my $sth = $self->db->prepare_cached( 133 158 q{delete from group_attributes_users where value = ? and attr = ? and okey = ?} … … 142 167 } 143 168 if (keys %fdata) { 144 return $res + $self->SUPER::set_fields(%fdata); 169 my $setres = $self->SUPER::set_fields(%fdata); 170 if (defined($setres)) { return $res + $setres; } 171 else { return; } 145 172 } else { 146 173 $res -
LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Sql/Revaliases.pm
r353 r861 44 44 sub has_extended_attributes { 0 } 45 45 46 sub _get_attr_schema { 47 my ($class, $base) = @_; 48 49 $class->SUPER::_get_attr_schema($base, 50 { 51 name => { reference => 'user', inline => 1, }, 52 } 53 ) 54 } 55 46 56 sub _create { 47 57 my ($class, $base, $id, %data) = @_; -
LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Sql/Site.pm
r769 r861 43 43 sub has_extended_attributes { 1 } 44 44 45 sub _inline_fields { 46 my ($class, $for, $base) = @_; 47 return ( 48 expire => 'expire', 49 ($for !~ /w/) ? ( 50 name => 'name', 51 cn => 'name', 52 create => 'create', 53 date => 'date', 54 ) : (), 55 ); 56 } 45 sub _get_attr_schema { 46 my ($class, $base) = @_; 57 47 58 sub _managed_fields { 59 my ($self, $for, $base) = @_;60 $for !~ /w/ ? (61 postalAddress => 'postalAddress',62 ) : ()63 } 64 65 66 sub _delayed_fields { 67 my ($self)= @_;68 return qw();48 $class->SUPER::_get_attr_schema($base, 49 { 50 name => { ro => 1, inline => 1, }, 51 cn => { ro => 1, inline => 1, iname => 'name' }, 52 date => { ro => 1, inline => 1, }, 53 create => { ro => 1, inline => 1, }, 54 streetAddress => { formtype => 'TEXTAREA' }, 55 postalAddress => { ro => 1, }, 56 siteNick => { uniq => 1 }, 57 } 58 ) 69 59 } 70 60 -
LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Sql/Sutype.pm
r165 r861 43 43 sub has_extended_attributes { 0 } 44 44 45 sub _delayed_fields {46 my ($self)= @_;47 return qw();48 }49 50 45 1; 51 46 -
LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Sql/User.pm
r840 r861 45 45 sub has_extended_attributes { 1 } 46 46 47 sub _delayed_fields { 48 my ($self)= @_; 49 return qw(memberOf manager directReports department); 50 } 51 52 sub _office_address_fields { qw(telephoneNumber physicalDeliveryOfficeName site) } 53 54 sub _inline_fields { 55 my ($class, $for, $base) = @_; 56 return ( 57 uidNumber => 'uidnumber', 58 gidNumber => 'gidnumber', 59 exported => 'exported', 60 expire => 'expire', 61 ($for !~ /w/) ? ( 62 name => 'name', 63 cn => 'name', 64 create => 'create', 65 date => 'date', 66 ) : (), 67 ); 68 } 69 70 sub _managed_fields { 71 my ($self, $for, $base) = @_; 72 return ( 73 memberOf => 'memberOf', 74 forward => 'forward', 75 aliases => 'aliases', 76 revaliases => 'revaliases', 77 (map { $_ => $_ } $self->_address_fields), 78 (map { $_ => $_ } $self->_office_address_fields), 79 (($for !~ /w/) ? ( 80 uid => 'name', 81 cn => 'name', 82 gecos => 'gecos', 83 displayName => 'displayName', 84 sAMAccountName => 'sAMAccountName', 85 accountExpires => 'accountExpires', 86 shadowExpire => 'shadowExpire', 87 directReports => 'directReports', 88 managedObjects => 'managedObjects', 89 otheraddress => 'otheraddress', 90 mainaddress => 'mainaddress', 91 postalAddress => 'postalAddress', 92 facsimileTelephoneNumber => 'facsimileTelephoneNumber', 93 allsite => 'allsite', 94 managerContact => 'managerContact', 95 expireText => 'expireText', 96 cells => 'cells', 97 departments => 'departments', 98 ) : ()), 47 sub _get_attr_schema { 48 my ($class, $base) = @_; 49 50 $class->SUPER::_get_attr_schema($base, 51 { 52 uidNumber => { inline => 1, iname => 'uidnumber', uniq => 1, 53 mandatory => 1, }, 54 uidnumber => { inline => 1, hide => 1, }, 55 gidNumber => { 56 inline => 1, 57 iname => 'gidnumber', 58 mandatory => 1, 59 can_values => sub { 60 map { $base->get_object('group', 61 $_)->get_attributes('gidNumber') } 62 $base->list_objects('group') 63 }, 64 display => sub { 65 my ($self, $val) = @_; 66 my ($gr) = $self->base->search_objects('group', "gidNumber=$val") 67 or return; 68 return $gr; 69 }, 70 reference => 'group', 71 }, 72 loginShell => { mandatory => 1 }, 73 gidnumber => { inline => 1, hide => 1, 74 can_values => sub { 75 map { $_->get_attributes('gidNumber') } 76 map { $base->get_object('group', $_) } 77 $base->list_objects('group') 78 }, 79 mandatory => 1, 80 reference => 'group', 81 }, 82 exported => { 83 inline => 1, 84 formtype => 'CHECKBOX', 85 }, 86 locked => { 87 formtype => 'CHECKBOX', 88 formopts => { rawvalue => 1, }, 89 }, 90 expire => { inline => 1, formtype => 'DATE', }, 91 name => { inline => 1, ro => 1, }, 92 cn => { inline => 1, ro => 1, iname => 'name' }, 93 create => { inline => 1, ro => 1, }, 94 date => { inline => 1, ro => 1, }, 95 memberOf => { multiple => 1, delayed => 1, }, 96 forward => {}, 97 aliases => { 98 reference => 'aliases', 99 formtype => 'TEXT', 100 multiple => 1, 101 }, 102 revaliases => { 103 reference => 'revaliases', 104 formtype => 'TEXT', 105 }, 106 manager => { 107 delayed => 1, 108 can_values => sub { 109 my %uniq = map { $_ => 1 } grep { $_ } 110 ($_[1] ? $_[1]->get_attributes('manager') : ()), 111 $base->search_objects('user', 'active=*'); 112 sort keys %uniq; 113 }, 114 reference => 'user', 115 }, 116 department => { 117 reference => 'group', 118 can_values => sub { 119 $base->search_objects('group', 'sutype=dpmt') 120 } 121 }, 122 contratType => { 123 reference => 'group', 124 can_values => sub { 125 $base->search_objects('group', 'sutype=contrattype') 126 } 127 }, 128 site => { 129 reference => 'site', 130 can_values => sub { 131 $base->search_objects('site') 132 } 133 }, 134 co => { }, 135 l => { }, 136 postalCode => { }, 137 streetAddress => { formtype => 'TEXTAREA', }, 138 postOfficeBox => { }, 139 st => { }, 140 facsimileTelephoneNumber => { }, 141 o => { }, 142 telephoneNumber => { }, 143 physicalDeliveryOfficeName => { }, 144 uid => { iname => 'name', ro => 1 }, 145 cn => { iname => 'name', ro => 1 }, 146 gecos => { ro => 1, }, 147 displayName => { ro => 1, managed => 1, }, 148 sAMAccountName => { ro => 1, managed => 1 }, 149 accountExpires => { ro => 1, managed => 1 }, 150 shadowExpire => { ro => 1, managed => 1 }, 151 directReports => { 152 reference => 'user', 153 ro => 1, 154 delayed => 1, 155 }, 156 managedObjects => { ro => 1, reference => 'group', }, 157 otheraddress => { ro => 1, reference => 'address', }, 158 mainaddress => { ro => 1, reference => 'address', }, 159 postalAddress => { ro => 1, }, 160 facsimileTelephoneNumber => { ro => 1, }, 161 allsite => { 162 ro => 1, 163 reference => 'site', 164 }, 165 managerContact => { 166 ro => 1, 167 reference => 'user', 168 }, 169 expireText => { ro => 1, }, 170 krb5ValidEnd => { ro => 1, }, 171 cells => { 172 ro => 1, 173 reference => 'group', 174 }, 175 departments => { 176 reference => 'group', 177 delayed => 1, 178 ro => 1, 179 }, 180 arrivalDate => { }, 181 expired => { ro => 1 }, 182 active => { ro => 1 }, 183 pwdAccountLockedTime => { managed => 1, ro => 1 } 184 } 99 185 ) 100 186 } … … 177 263 $res->{expire} =~ /(\d+) days\s*(\w)?/; 178 264 return $1 + ($2 ? 1 : 0); 265 } elsif ($field eq 'krb5ValidEnd') { 266 my $sth = $self->db->prepare_cached( 267 sprintf( 268 q{select date_part('epoch', expire)::int as expire 269 from %s where %s = ?}, 270 $self->db->quote_identifier($self->object_table), 271 $self->db->quote_identifier($self->key_field), 272 ) 273 ); 274 $sth->execute($self->id); 275 my $res = $sth->fetchrow_hashref; 276 $sth->finish; 277 return $res->{expire} 179 278 } elsif ($field eq 'expireText') { 180 279 my $sth = $self->db->prepare_cached( … … 190 289 $sth->finish; 191 290 return $res->{expire} 291 } elsif ($field eq 'pwdAccountLockedTime') { 292 if ($self->_get_c_field('locked')) { 293 return '000001010000Z'; 294 } else { 295 my $sth = $self->db->prepare_cached( 296 sprintf( 297 q{select to_char(expire AT TIME ZONE 'Z', 'YYYYMMDDHH24MISSZ') as expire 298 from %s where %s = ? and expire < now()}, 299 $self->db->quote_identifier($self->object_table), 300 $self->db->quote_identifier($self->key_field), 301 ) 302 ); 303 $sth->execute($self->id); 304 my $res = $sth->fetchrow_hashref; 305 $sth->finish; 306 return $res->{expire} 307 } 192 308 } elsif ($field eq 'otheraddress') { 193 309 my $sth = $self->db->prepare_cached(q{ … … 209 325 $sth->finish; 210 326 return $res->{name}; 211 } elsif (grep { $field eq $_ } __PACKAGE__->_address_fields(), 212 $self->_office_address_fields, 'postalAddress') { 327 } elsif (grep { $field eq $_ } qw(postalAddress 328 co l postalCode streetAddress 329 postOfficeBox st 330 facsimileTelephoneNumber 331 o telephoneNumber 332 physicalDeliveryOfficeName 333 site 334 )) { 213 335 if (my $fmainaddress = $self->_get_c_field('mainaddress')) { 214 336 my $address = $self->base->get_object('address', $fmainaddress); … … 262 384 } 263 385 386 sub _get_state { 387 my ($self, $state) = @_; 388 for ($state) { 389 /^expired$/ and do { 390 my $attribute = $self->attribute('expire'); 391 $attribute->check_acl('r') or return; 392 my $sth = $self->db->prepare_cached( 393 q{ select coalesce(expire < now(), false) as exp from "user" 394 where "user".name = ?} 395 ); 396 $sth->execute($self->id); 397 my $res = $sth->fetchrow_hashref; 398 $sth->finish; 399 return $res->{exp} ? 1 : 0; 400 }; 401 } 402 } 403 264 404 sub set_fields { 265 405 my ($self, %data) = @_; … … 267 407 my $res = 0; 268 408 foreach my $attr (keys %data) { 409 $attr eq 'gidnumber' && $data{$attr} !~ /^\d+$/ and do { 410 my $group = $self->base->get_object('group', $data{$attr}) or do { 411 $self->base->log(LA_ERROR, 412 "Can't set gidNumber to %s: no such group", $data{$attr}); 413 return; 414 }; 415 $data{$attr} = $group->get_attributes('gidNumber'); 416 }; 269 417 $attr =~ /^memberOf$/ and do { 270 418 my %member; … … 287 435 $res++; 288 436 } elsif ($member{$_}{c}) { 437 if (($self->get_c_field('department') || '') eq $group->id) { 438 $self->base->log(LA_WARN, 439 "Don't removing user %s from group %s: is it's department", 440 $self->id, $group->id); 441 next; 442 } 289 443 my $sth = $self->db->prepare_cached( 290 444 q{delete from group_attributes_users where value = ? and attr = ? and okey = ?} … … 421 575 } 422 576 }; 423 grep { $attr eq $_ } (__PACKAGE__->_office_address_fields, __PACKAGE__->_address_fields()) and do { 577 grep { $attr eq $_ } (qw(co l postalCode streetAddress 578 postOfficeBox st facsimileTelephoneNumber 579 o telephoneNumber physicalDeliveryOfficeName site)) and do { 424 580 my $fmainaddress = $self->_get_c_field('mainaddress'); 425 581 # set address attribute => create address object on the fly … … 439 595 if ($fmainaddress && 440 596 (my $address = $self->base->get_object('address', $fmainaddress))) { 441 $res += $address->set_c_fields($attr => $data{$attr}) ||0; 597 if ($address->attribute($attr) && 598 !$address->attribute($attr)->ro) { 599 $res += $address->set_c_fields($attr => $data{$attr}) ||0; 600 } 442 601 } 443 602 next; … … 446 605 } 447 606 if (keys %fdata) { 448 return $self->SUPER::set_fields(%fdata) + $res; 607 if (defined(my $res2 = $self->SUPER::set_fields(%fdata))) { 608 return $res2 + $res; 609 } else { 610 return; 611 } 449 612 } else { return $res; } 450 613 } -
LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Sql/objects.pm
r764 r861 28 28 =cut 29 29 30 # This fields are special in sense they may come from site field31 sub _address_fields { qw(co l postalCode streetAddress postOfficeBox st32 facsimileTelephoneNumber o) }33 34 30 =head1 FUNCTIONS 35 31 … … 45 41 46 42 =cut 43 44 sub attributes_table { $_[0]->object_table . '_attributes_list' } 47 45 48 46 sub list { … … 87 85 sub has_extended_attributes { 0 } 88 86 89 # Work only for very simple case, must be override 90 91 sub _inline_fields { 92 my ($self, $for, $base) = @_; 93 if ($base->{__cache}{$self->object_table}) { 94 return %{$base->{__cache}{$self->object_table}}; 95 } 96 my @res; 97 my $sth = $base->db->prepare( 98 q{SELECT column_name FROM information_schema.columns 99 WHERE table_name = ?} 100 ); 101 $sth->execute($self->object_table); 102 while (my $res = $sth->fetchrow_hashref) { 103 if ($for =~ 'w') { 104 next if($res->{column_name} =~ /^(rev|date|create|ikey)$/); 105 next if($res->{column_name} eq $self->key_field); 106 } 107 push(@res, $res->{column_name}); 108 } 109 my %fields = map { $_ => $_ } @res; 110 $base->{__cache}{$self->object_table} = \%fields; 111 %fields 87 sub _get_attr_schema { 88 my ($class, $base, $info) = @_; 89 $info ||= {}; 90 if (!$base->{__cache}{$class->object_table}{inline}) { 91 $base->{__cache}{$class->object_table}{inline} = []; 92 my $sth = $base->db->prepare( 93 q{SELECT column_name FROM information_schema.columns 94 WHERE table_name = ?} 95 ); 96 $sth->execute($class->object_table); 97 while (my $res = $sth->fetchrow_hashref) { 98 push(@{$base->{__cache}{$class->object_table}{inline}}, 99 $res->{column_name}); 100 } 101 } 102 foreach (@{$base->{__cache}{$class->object_table}{inline}}) { 103 $info->{$_}{inline} = 1; 104 if (m/^(rev|date|create|ikey)$/) { 105 $info->{$_}{ro} = 1 106 } 107 } 108 if ($class->has_extended_attributes) { 109 if (!$base->{__cache}{$class->object_table}{extend}) { 110 $base->{__cache}{$class->object_table}{extend} = []; 111 my $sth = $base->db->prepare_cached( 112 sprintf( 113 q{select canonical from %s order by canonical}, 114 $base->db->quote_identifier($class->attributes_table), 115 ) 116 ); 117 $sth->execute; 118 while (my $res = $sth->fetchrow_hashref) { 119 push(@{$base->{__cache}{$class->object_table}{extend}}, 120 $res->{canonical}); 121 } 122 } 123 foreach (@{$base->{__cache}{$class->object_table}{extend}}) { 124 $info->{$_} ||= {}; 125 } 126 } 127 $info->{exported} = { inline => 1, formtype => 'CHECKBOX', hide => 1, }; 128 $info->{unexported} = { inline => 1, formtype => 'CHECKBOX', }; 129 130 $info 112 131 } 113 132 … … 117 136 my ($class, $for, $base) = @_; 118 137 return(); 119 }120 121 # Everything from attributes_list table122 # $for is uneeded here as all this attributes are rw123 124 sub _extended_field {125 my ($class, $for, $base) = @_;126 my @attr;127 if ($class->has_extended_attributes) {128 if ($base->{__cache}{_extended_field}{$class}) {129 return map { $_ => $_ }130 @{$base->{__cache}{_extended_field}{$class}};131 }132 my $sth = $base->db->prepare_cached(133 sprintf(134 q{select canonical from %s order by canonical},135 $base->db->quote_identifier($class->object_table . '_attributes_list'),136 )137 );138 $sth->execute;139 while (my $res = $sth->fetchrow_hashref) {140 push(@attr, $res->{canonical});141 }142 $base->{__cache}{_extended_field}{$class} = \@attr;143 return map { $_ => $_ } @attr;144 } else {145 return ()146 }147 }148 149 sub _canonical_fields {150 my ($class, $base, $for) = @_;151 $for ||= 'rw';152 my %inl = (153 ($class->_inline_fields($for, $base)),154 ($class->_managed_fields($for, $base)),155 ($class->_extended_field($for, $base)),156 );157 return sort keys %inl;158 }159 160 sub _get_field_name_db {161 my ($class, $c_field, $base) = @_;162 $class->has_extended_attributes or return;163 $class->object_table or return;164 my $sth = $base->db->prepare_cached(165 sprintf(166 q{select ikey from %s where canonical = ?},167 $base->db->quote_identifier($class->object_table . '_attributes_list'),168 )169 );170 $sth->execute($c_field);171 172 my $res = $sth->fetchrow_hashref;173 $sth->finish;174 return $c_field if($res->{ikey});175 }176 177 sub _get_field_name {178 my ($class, $c_field, $base, $for) = @_;179 $c_field or return;180 $for ||= 'rw';181 my %fields = $class->_managed_fields($for, $base);182 return $fields{$c_field} if ($fields{$c_field});183 %fields = $class->_inline_fields($for, $base);184 return $fields{$c_field} if ($fields{$c_field});185 %fields = $class->_extended_field($for, $base);186 return $fields{$c_field}187 138 } 188 139 … … 198 149 my $count = $sth->execute($id); 199 150 $sth->finish; 200 $count== 1 or return;151 ($count || 0) == 1 or return; 201 152 $class->SUPER::new($base, $id); 202 153 } … … 223 174 224 175 # splitting inline from extended 225 my %inlined = $class->_inline_fields('w', $base);226 my %inl = map { $_ => 1 } values %inlined;227 176 my (%first, %second); 177 # Ensure object is exported if not specified 178 $data{exported} = 1 if (!exists($data{exported})); 179 if (exists $data{unexported}) { 180 $data{exported} = $data{unexported} ? 0 : 1; 181 delete $data{unexported} 182 } 228 183 foreach (keys %data) { 229 $_ =~ /exported/ and $data{$_} = $data{$_} ? 1 : 0; 230 if ($inl{$_}) { 184 my $attr = $base->attribute($class->type, $_) or next; 185 $_ =~ /^exported$/ and $data{$_} = $data{$_} ? 1 : 0; 186 if ($attr->{inline}) { 231 187 $first{$_} = $data{$_}; 232 188 } else { … … 276 232 ); 277 233 278 if ( $sthr->execute($newid, $id) != 1) {234 if (($sthr->execute($newid, $id) || 0) != 1) { 279 235 $base->log(LA_ERR, "Erreur renaming %s %s to %s", 280 236 $class->type, … … 303 259 sub get_field { 304 260 my ($self, $field) = @_; 305 my %inl = $self->_inline_fields('r', $self->base); 306 my %inline = map { $_ => 1 } values %inl; 307 if ($inline{$field}) { 261 if ($field eq 'unexported') { 262 return $self->get_field('exported') ? undef : 1; 263 } 264 my $attr = $self->attribute($field) or return; 265 if ($attr->{inline}) { 308 266 my $sth = $self->db->prepare_cached( 309 267 sprintf( … … 335 293 ) 336 294 ); 337 $sth->execute($self->id); #, $field);295 $sth->execute($self->id); 338 296 delete($__cache->{$self->id}); 339 297 $__cache->{$self->id}{__time} = time; … … 354 312 my @vals; 355 313 my %ext; 356 my %inl = $self->_inline_fields('w', $self->base); 357 my %inline = map { $_ => 1 } values %inl; 314 if (exists($data{unexported})) { 315 $data{exported} = $data{unexported} ? 0 : 1; 316 } 358 317 foreach my $field (keys %data) { 359 $data{$field} = $data{$field} ? 1 : 0 if($field eq 'exported'); 318 my $attr = $self->attribute($field); 319 next if ($field eq 'unexported'); 360 320 my $oldval = $self->get_field($field); 361 321 next if (($data{$field} || '') eq ($oldval || '')); 362 if ($ inline{$field}) {322 if ($attr->{inline}) { 363 323 # TODO check fields exists ! 364 324 push(@fields, sprintf("%s = ?", $self->db->quote_identifier($field))); … … 378 338 ); 379 339 $sth->execute(@vals, $self->id) or do { 380 $self->base->log(LA_ERR, "Cannot update inline field %s" . 381 $self->base->db->strerr); 340 $self->base->log(LA_ERR, 341 "Cannot update inline field for object %s, %s: %s", 342 $self->type, 343 $self->id, 344 $self->base->db->errstr); 382 345 return; 383 346 }; … … 392 355 ), 393 356 ); 357 my $sthd1 = $self->db->prepare_cached( 358 sprintf( 359 q{delete from %s where okey = ? and attr = ? and value = ?}, 360 $self->db->quote_identifier($self->object_table. '_attributes'), 361 ), 362 ); 394 363 my $sthx = $self->db->prepare_cached( 395 364 sprintf( … … 406 375 407 376 my $okey = $self->_get_ikey($self->base, $self->id); 408 foreach (keys %ext) { 409 if ($ext{$_}) { 410 my $res = $sthu->execute($ext{$_}, $okey, $_); 411 defined($res) or do { 412 $self->base->log(LA_ERR, 413 "Error while udapting attributes: %s", 414 $self->base->db->strerr 415 ); 416 return; 417 }; 418 if ($res == 0) { 419 $res = $sthx->execute($okey, $_, $ext{$_}); 377 foreach my $uattr (keys %ext) { 378 my $attr = $self->attribute($uattr); 379 if ($ext{$uattr}) { 380 if ($attr->{multiple}) { 381 my $updated = 0; 382 my $oldvalue = $self->get_field($uattr); 383 my %newvalues = map { $_ => 1 } (ref $ext{$uattr} 384 ? @{$ext{$uattr}} 385 : $ext{$uattr}); 386 foreach (grep { $_ } ref $oldvalue ? @{$oldvalue} : $oldvalue) { 387 if(exists($newvalues{$_})) { 388 $newvalues{$_} = 0; 389 } else { 390 defined($sthd1->execute($okey, $uattr, $_)) or do { 391 $self->base->log(LA_ERR, 392 "Error while updating attributes on %s/%s %s: %s", 393 $self->type, 394 $self->id, 395 $uattr, 396 $self->base->db->errstr 397 ); 398 return; 399 }; 400 $updated++; 401 } 402 } 403 foreach (grep { $newvalues{$_} } keys %newvalues) { 404 $sthx->execute($okey, $uattr, $_) or do { 405 $self->base->log(LA_ERR, 406 "Error while updating attributes: %s/%s %s: %s", 407 $self->type, 408 $self->id, 409 $uattr, 410 $self->base->db->errstr 411 ); 412 return; 413 }; 414 $updated++; 415 } 416 $updated_attributes++ if ($updated); 417 } else { 418 my $res = $sthu->execute($ext{$uattr}, $okey, $uattr); 420 419 defined($res) or do { 421 420 $self->base->log(LA_ERR, 422 "Error while udapting attributes: %s", 423 $self->base->db->strerr 421 "Error while udapting attributes: %s/%s %s: %s", 422 $self->type, 423 $self->id, 424 $uattr, 425 $self->base->db->errstr 424 426 ); 427 $updated_attributes++; 425 428 return; 426 429 }; 430 if ($res == 0) { 431 $res = $sthx->execute($okey, $uattr, $ext{$uattr}); 432 defined($res) or do { 433 $self->base->log(LA_ERR, 434 "Error while updating attributes: %s/%s %s: %s", 435 $self->type, 436 $self->id, 437 $uattr, 438 $self->base->db->errstr 439 ); 440 $updated_attributes++; 441 return; 442 }; 443 } 427 444 } 428 445 } else { 429 defined($sthd->execute($okey, $ _)) or do {446 defined($sthd->execute($okey, $uattr)) or do { 430 447 $self->base->log(LA_ERR, 431 "Error while deleting attributes: %s", 432 $self->base->db->strerr 448 "Error while deleting attributes: %s/%s %s: %s", 449 $self->otype, 450 $self->id, 451 $uattr, 452 $self->base->db->errstr 433 453 ); 434 454 return; … … 445 465 sub attributes_summary { 446 466 my ($class, $base, $attribute) = @_; 447 $class->has_extended_attributes && $class->object_table or 467 my $attr = $base->attribute($class->type, $attribute); 468 if ($attr->{managed}) { 448 469 return $class->SUPER::attributes_summary($base, $attribute); 470 } 449 471 my $sth = $base->db->prepare_cached( 450 sprintf( 451 q{select value from %s where attr = ? group by value}, 452 $base->db->quote_identifier($class->object_table . 453 '_attributes'), 454 ) 455 ); 456 $sth->execute($attribute); 472 $attr->{inline} 473 ? sprintf( 474 q{select %s as value from %s}, 475 $base->db->quote_identifier($attr->iname), 476 $base->db->quote_identifier($class->object_table), 477 ) 478 : sprintf( 479 q{select value from %s where attr = ? group by value}, 480 $base->db->quote_identifier($class->object_table . 481 '_attributes'), 482 ) 483 ); 484 $sth->execute($attr->{inline} ? () : ($attribute)); 457 485 458 486 my @values; … … 465 493 sub _set_password { 466 494 my ($self, $clear_pass) = @_; 467 if (my $field = $self->base->get_field_name($self->type, 'userPassword')) { 495 if (my $attr = $self->base->attribute($self->type, 'userPassword')) { 496 my $field = $attr->iname; 468 497 my @salt_char = (('a' .. 'z'), ('A' .. 'Z'), (0 .. 9), '/', '.'); 469 498 my $salt = join('', map { $salt_char[rand(scalar(@salt_char))] } (1 .. 8)); 470 499 my $res = $self->set_fields($field, crypt($clear_pass, '$1$' . $salt)); 500 if (!$res) { 501 return; 502 } 471 503 472 504 if (my $serialize = $self->base->get_global_value('rsa_public_key')) { … … 479 511 Armour => 1, 480 512 ) || die $self->poll->rsa->errstr(); 481 $self->set_c_fields('encryptedPassword', $rsa_password); 513 return $self->set_c_fields('encryptedPassword', $rsa_password); 514 } else { 515 return 1; 482 516 } 483 517 } else { … … 490 524 my ($class, $base, @filter) = @_; 491 525 492 if ($class->has_extended_attributes) { 493 my %attrsql; 494 my %attrbind; 495 while (my $item = shift(@filter)) { 496 # attr=foo => no extra white space ! 497 # \W is false, it is possible to have two char 498 my ($attr, $mode, $val) = $item =~ /^(\w+)(?:(\W)(.+))?$/ or next; 499 if (!$mode) { 500 $mode = '~'; 501 $val = shift(@filter); 502 } 503 $val ||= ''; 504 push(@{ $attrsql{$attr} }, 505 sprintf("\n\t" . q{select okey from %s where attr=? %s} . "\n", 506 $base->db->quote_identifier($class->object_table . 507 '_attributes'), 508 $val eq '*' 509 ? '' 510 : ($mode eq '~' 511 ? q{and value ILIKE ?} 512 : q{and value = ?} ) 513 ) 526 my %attrsql; 527 my %attrbind; 528 529 while (my $item = shift(@filter)) { 530 # attr=foo => no extra white space ! 531 # \W is false, it is possible to have two char 532 my ($attr, $mode, $val) = $item =~ /^(\w+)(?:(\W)(.+))?$/ or next; 533 if (!$mode) { 534 $mode = '~'; 535 $val = shift(@filter); 536 } 537 my $attribute = $base->attribute($class->type, $attr) or do { 538 $base->log(LA_ERR, "Unknown attribute $attr"); 539 next; 540 }; 541 defined($val) or $val = ''; 542 $val = $attribute->input($val); 543 544 my $sql; 545 546 # Specific case for unexported attribute, comming from exported value 547 if ($attribute->iname eq 'unexported') { 548 $sql = sprintf( 549 q{select ikey from %s where %s}, 550 $base->db->quote_identifier($class->object_table), 551 $val ? q{exported='f'} : q{exported='t'} 552 ) 553 } elsif ($attribute->{inline}) { 554 $sql = sprintf( 555 q{select ikey from %s where %s %s}, 556 $base->db->quote_identifier($class->object_table), 557 $base->db->quote_identifier($attribute->iname), 558 $val eq '*' 559 ? 'is not NULL' 560 : $mode eq '~' 561 ? 'ILIKE ?' 562 : '= ?' 514 563 ); 515 push(@{$attrbind{$attr}}, $base->get_field_name($class->type, $attr, 'r'));516 564 push(@{$attrbind{$attr}}, $mode eq '~' ? '%' . $val . '%' : $val) unless($val eq '*'); 517 } 518 # building the query 519 my @sqlintersec; 520 if (!$base->{wexported}) { 521 push(@sqlintersec, sprintf( 522 q{select ikey from %s where exported = true}, 523 $base->db->quote_identifier($class->object_table) 524 ) 525 ); 526 } 527 my @bind; 528 foreach (keys %attrsql) { 529 push(@sqlintersec, '(' . join(" union ", @{$attrsql{$_}}) . ")\n"); 530 push(@bind, @{$attrbind{$_}}); 531 } 532 my $sth = $base->db->prepare( 533 sprintf(q{ 534 select name from %s 535 %s 536 }, 537 $base->db->quote_identifier($class->object_table), 538 @sqlintersec 539 ? "where ikey in (\n" . join("\n intersect\n", @sqlintersec) . ")\n" 540 : '', 541 ) 542 ); 543 $sth->execute(@bind); 544 my @results; 545 while (my $res = $sth->fetchrow_hashref) { 546 push(@results, $res->{name}); 547 } 548 return(@results); 565 } else { 566 $sql = sprintf( 567 q{select okey from %s where attr = ? %s}, 568 $base->db->quote_identifier( 569 $class->object_table . '_attributes' 570 ), 571 $val eq '*' 572 ? '' 573 : $mode eq '~' 574 ? q{and value ILIKE ?} 575 : q{and value = ?} 576 577 ); 578 push(@{$attrbind{$attr}}, $attribute->iname); 579 push(@{$attrbind{$attr}}, $mode eq '~' ? '%' . $val . '%' : $val) unless($val eq '*'); 580 } 581 582 push(@{ $attrsql{$attr} }, $sql); 583 } 584 # building the query 585 my @sqlintersec; 586 if (!$base->{wexported}) { 587 push(@sqlintersec, sprintf( 588 q{select ikey from %s where exported = true}, 589 $base->db->quote_identifier($class->object_table) 590 ) 591 ); 592 } 593 my @bind; 594 foreach (keys %attrsql) { 595 push(@sqlintersec, '(' . join(" union ", @{$attrsql{$_}}) . ")\n"); 596 push(@bind, @{$attrbind{$_} || []}); 597 } 598 my $sth = $base->db->prepare( 599 sprintf(q{ 600 select name from %s 601 %s 602 order by name 603 }, 604 $base->db->quote_identifier($class->object_table), 605 @sqlintersec 606 ? "where ikey in (\n" . join("\n intersect\n", @sqlintersec) . ")\n" 607 : '', 608 ) 609 ); 610 $sth->execute(@bind); 611 my @results; 612 while (my $res = $sth->fetchrow_hashref) { 613 push(@results, $res->{name}); 614 } 615 return(@results); 616 } 617 618 sub register_attribute { 619 my ($class, $base, $attribute, $comment) = @_; 620 621 $base->attribute($class->type, $attribute) and do { 622 $base->log(LA_ERR, "The attribute $attribute already exists"); 623 return; 624 }; 625 my $sth = $base->db->prepare( 626 sprintf(q{ 627 insert into %s (canonical, description) 628 values (?,?) 629 }, $class->attributes_table) 630 ); 631 my $res = $sth->execute($attribute, $comment); 632 } 633 634 sub get_attribute_comment { 635 my ($class, $base, $attribute) = @_; 636 $base->attribute($class->type, $attribute) or do { 637 $base->log(LA_ERR, "The attribute $attribute does not exists"); 638 return; 639 }; 640 my $sth = $base->db->prepare( 641 sprintf(q{ 642 select description from %s 643 where canonical = ? 644 }, $class->attributes_table) 645 ); 646 $sth->execute($attribute); 647 if (my $res = $sth->fetchrow_hashref) { 648 $sth->finish; 649 return $res->{description}; 549 650 } else { 550 my @bind; 551 my @where; 552 while (my $item = shift(@filter)) { 553 # attr=foo => no extra white space ! 554 # \W is false, it is possible to have two char 555 my ($attr, $mode, $val) = $item =~ /^(\w+)(?:(\W)(.+))?$/ or next; 556 if (!$mode) { 557 $mode = '~'; 558 $val = shift(@filter); 559 } 560 if ($val eq '*') { 561 push(@where, sprintf("%s is not NULL", 562 $base->db->quote_identifier($base->get_field_name($class->type, 563 $attr, 'r')) 564 ) 565 ); 566 } else { 567 push(@where, sprintf("%s %s ?", 568 $base->db->quote_identifier( 569 $base->get_field_name($class->type, $attr, 'r') 570 ), 571 $mode eq '~' ? 'ILIKE' : '=', 572 )); 573 push(@bind, lc($val)); 574 } 575 } 576 my $sth = $base->db->prepare( 577 sprintf(q{select name from %s where %s}, 578 $base->db->quote_identifier($class->object_table), 579 join(' and ', @where), 580 ) 581 ); 582 $sth->execute(@bind); 583 my @results; 584 while (my $res = $sth->fetchrow_hashref) { 585 push(@results, $res->{name}); 586 } 587 return(@results); 588 } 589 } 651 return; 652 } 653 } 654 655 sub set_attribute_comment { 656 my ($class, $base, $attribute, $comment) = @_; 657 658 my $attr = $base->attribute($class->type, $attribute) or do { 659 $base->log(LA_ERR, "The attribute $attribute does not exists"); 660 return; 661 }; 662 $attr->{inline} and do { 663 $base->log(LA_ERR, 664 "Cannot set comment to inline attribute, sorry, blame the author !" 665 ); 666 return; 667 }; 668 my $sth = $base->db->prepare( 669 sprintf(q{ 670 update %s set description = ? 671 where canonical = ? 672 }, $class->attributes_table) 673 ); 674 my $res = $sth->execute($comment, $attribute); 675 } 676 677 590 678 591 679 1; -
LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Unix.pm
r815 r861 43 43 44 44 my $base = { 45 passwd => $options{passwd} || '/etc/passwd',46 shadow => $options{shadow} || '/etc/shadow',47 group => $options{group} || '/etc/group',48 gshadow => $options{gshadow} || '/etc/gshadow',49 45 # are we using shadow, default to yes 50 46 use_shadow => (defined($options{use_shadow}) ? $options{use_shadow} : 1), … … 56 52 }; 57 53 54 foreach (qw(passwd shadow group gshadow)) { 55 if ($options{$_}) { 56 $base->{$_} = $options{$_}; 57 } elsif ($options{directory}) { 58 $base->{$_} = $options{directory} . '/' . $_; 59 } else { 60 $base->{$_} = "/etc/$_"; 61 } 62 } 63 64 58 65 bless($base, $class); 59 }60 61 sub _canonicals_fields {62 my ($self, $type, $for) = @_;63 $type = lc($type);64 {65 user => {66 uidNumber => 'uid',67 gidNumber => 'gid',68 gecos => 'gecos',69 homeDirectory => 'home',70 loginShell => 'shell',71 userPassword => ($self->{use_shadow} ? 'spassword' : 'password'),72 memberOf => 'memberOf',73 locked => 'locked',74 ($for !~ /w/ ? (75 givenName => 'givenName',76 sn => 'sn',77 uid => 'login',78 sAMAccountName => 'login',79 ) : ()),80 $self->{use_shadow} ?81 (82 shadowLastChange => 'last_changed',83 shadowMin => 'before_ch',84 shadowMax => 'after_ch',85 shadowWarning => 'exp_warn',86 shadowInactive => 'exp_disable',87 shadowExpire => 'disable',88 shadowFlag => 'res',89 ) : (),90 # description => not supported91 },92 group => {93 ($for !~ /w/ ? (94 sAMAccountName => 'group_name',95 ) : ()),96 gidNumber => 'gid',97 memberUID => 'user_list',98 },99 }->{$type}100 }101 102 sub list_canonical_fields {103 my ($self, $type, $for) = @_;104 $for ||= 'rw';105 keys %{ $self->_canonicals_fields($type, $for) || {} }106 }107 108 sub get_field_name {109 my ($self, $type, $cfield, $for) = @_;110 $for ||= 'rw';111 ($self->_canonicals_fields($type, $for) || {})->{$cfield}112 66 } 113 67 … … 248 202 truncate($handle, 0); 249 203 foreach my $line (@data) { 250 print $handle join(':', map { defined($_) ? $_ : '' } @$line) . "\n";204 print $handle join(':', map { my $f = $_; $f =~ s/:/;/g; $f } map { defined($_) ? $_ : '' } @$line) . "\n"; 251 205 } 252 206 close($handle); -
LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Unix/Group.pm
r807 r861 28 28 =cut 29 29 30 sub _get_attr_schema { 31 my ($class, $base) = @_; 32 { 33 sAMAccountName => { 34 iname => 'group_name', 35 ro => 1, 36 }, 37 gidNumber => { 38 iname => 'gid', 39 }, 40 memberUID => { 41 iname => 'user_list', 42 multiple => 1, 43 delayed => 1, 44 }, 45 }; 46 } 47 30 48 =head2 new(%options) 31 49 … … 47 65 return bless($base->{groups}{$id}, $class); 48 66 } else { return } 49 }50 51 sub _delayed_fields {52 my ($self)= @_;53 return qw(memberUID);54 67 } 55 68 -
LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Unix/User.pm
r806 r861 28 28 =cut 29 29 30 sub _get_attr_schema { 31 my ($class, $base) = @_; 32 { 33 uidNumber => { iname => 'uid', uniq => 1, }, 34 gidNumber => { iname => 'gid', 35 can_values => sub { 36 map { $_->get_attributes('gidNumber') } 37 map { $base->get_object('group', $_) } 38 $base->list_objects('group') 39 }, 40 reference => 'group', 41 mandatory => 1, 42 }, 43 gecos => { }, 44 homeDirectory => { iname => 'home' }, 45 loginShell => { iname => 'shell' }, 46 userPassword => { 47 iname => ($base->{use_shadow} ? 'spassword' : 'password') 48 }, 49 memberOf => { delayed => 1, }, 50 locked => {}, 51 givenName => { ro => 1 }, 52 sn => { ro => 1 }, 53 uid => { iname => 'login', ro => 1 }, 54 sAMAccountName => { iname => 'login', ro => 1 }, 55 $base->{use_shadow} ? 56 ( 57 shadowLastChange => { iname => 'last_changed' }, 58 shadowMin => { iname => 'before_ch' }, 59 shadowMax => { iname => 'after_ch' }, 60 shadowWarning => { iname => 'exp_warn' }, 61 shadowInactive => { iname => 'exp_disable' }, 62 shadowExpire => { iname => 'disable' }, 63 shadowFlag => { iname => 'res' }, 64 ) : (), 65 }; 66 } 67 30 68 =head2 new(%options) 31 32 Create a new LATMOS::Ad object for windows AD $domain.33 34 domain / server: either the Ad domain or directly the server35 36 ldap_args is an optionnal list of arguments to pass to L<Net::LDAP>.37 69 38 70 =cut … … 47 79 return bless($base->{users}{$id}, $class); 48 80 } else { return } 49 }50 51 sub _delayed_fields {52 my ($self)= @_;53 return qw(memberOf);54 81 } 55 82 -
LATMOS-Accounts/lib/LATMOS/Accounts/Cli.pm
r851 r861 9 9 use Term::ReadLine; 10 10 use Text::ParseWords; 11 use Getopt::Long; 12 13 { 14 open (my $fh, "/dev/tty" ) 15 or eval 'sub Term::ReadLine::findConsole { ("&STDIN", "&STDERR") }'; 16 die $@ if $@; 17 close ($fh); 18 } 11 19 12 20 my $term = Term::ReadLine->new('LA CLI'); 21 $term->MinLine(99999); 13 22 my $OUT = $term->OUT || \*STDOUT; 23 24 my $trans_mode = 0; 14 25 15 26 sub globalenv { … … 29 40 if ($arg eq 'yes') { 30 41 $env->base->unexported(1); 31 print $OUT "Unexported are now show ";42 print $OUT "Unexported are now show\n"; 32 43 } elsif ($arg eq 'no') { 33 44 $env->base->unexported(0); 34 print $OUT "Unexported are no longer show ";45 print $OUT "Unexported are no longer show\n"; 35 46 } elsif ($arg eq 'show') { 36 print $OUT "Unexported objects " . $env->base->unexported ?37 "enable" : "disable" ;47 print $OUT "Unexported objects " . ($env->base->unexported ? 48 "enable" : "disable") . "\n"; 38 49 } else { 39 print $OUT "wrong argument ";50 print $OUT "wrong argument\n"; 40 51 } 41 52 }, … … 52 63 print $OUT map { "$_\n" } $_[0]->base->list_objects($_[1]); 53 64 } else { 54 print $OUT "Object type missing ";65 print $OUT "Object type missing\n"; 55 66 } 56 67 }, … … 71 82 $env->{_lastsearchtype} = $args[0]; 72 83 } else { 73 print $OUT "Object type missing ";84 print $OUT "Object type missing\n"; 74 85 } 75 86 }, … … 112 123 @ids = @{$env->{_lastsearch}}; 113 124 } else { 114 print $OUT "No results store from previous search ";125 print $OUT "No results store from previous search\n"; 115 126 return; 116 127 } 117 128 } 118 129 if (!@ids) { 119 print $OUT 'not enough arguments' ;130 print $OUT 'not enough arguments' . "\n"; 120 131 return; 121 132 } 122 133 foreach (@ids) { 123 134 my $obj = $env->base->get_object($otype, $_) or do { 124 print $OUT "Cannot get $otype $_ ";135 print $OUT "Cannot get $otype $_\n"; 125 136 return; 126 137 }; 127 138 push(@objs, $obj); 128 139 } 129 print $OUT "Selecting $otype " . join(', ', @ids) ;140 print $OUT "Selecting $otype " . join(', ', @ids) . "\n"; 130 141 objenv($_[0]->base, $otype, @objs)->cli(); 131 142 }, 132 143 }); 144 $env->add_func('create', { 145 code => sub { 146 my ($env, $otype) = @_; 147 my $helper = $env->base->ochelper($otype); 148 my $info = undef; 149 while (1) { 150 my $status; 151 ($status, $info) = $helper->step($info); 152 153 if ($status ne 'NEEDINFO') { 154 if ($status eq 'CREATED') { 155 print $OUT "Object created\n"; 156 $env->commit; 157 } else { 158 print $OUT "Nothing done\n"; 159 $env->rollback; 160 } 161 return; 162 } 163 164 if ($info->{name}{ask}) { 165 my $line = $term->readline("Name of the object ?"); 166 $info->{name}{content} = $line; 167 } 168 foreach my $attr (@{$info->{ask} || []}) { 169 $term->Attribs->{completion_function} = sub { 170 $info->{contents}{$attr} 171 }; 172 my $line = $term->readline(sprintf(' %s %s? ', 173 $attr, 174 $info->{contents}{$attr} 175 ? '(' . $info->{contents}{$attr} . ') ' 176 : '' 177 )); 178 $info->{contents}{$attr} = $line if($line); 179 } 180 } 181 }, 182 } 183 ); 184 $env->add_func('exchangeip', 185 { 186 help => 'Exchange two IP on host', 187 code => sub { 188 my ($env, @args) = @_; 189 my ($ip1, $ip2) = 190 grep { $_ && $_ =~ /\d+\.\d+\.\d+\.\d+/ } @args; 191 if (!$ip2) { 192 print $OUT "Need two ip to exchange\n"; 193 return; 194 } 195 if ($env->base->nethost_exchange_ip($ip1, $ip2)) { 196 print $OUT "$ip1 and $ip2 get exchange\n"; 197 $env->commit; 198 } else { 199 $env->rollback; 200 } 201 }, 202 completion => sub { 203 my ($env, $carg, @args) = @_; 204 if ($args[-1] && $args[-1] !~ m/\d+\.\d+\.\d+\.\d+/) { 205 if (my $obj = $env->base->get_object('nethost', $args[-1])) { 206 return $obj->get_attributes('ip'); 207 } 208 } else { 209 my @list = 210 ($env->base->attributes_summary('nethost', 'ip'), 211 $env->base->list_objects('nethost')); 212 return @list; 213 } 214 }, 215 } 216 ); 133 217 $env->add_func('user', { alias => [qw'select user' ] }); 134 218 $env->add_func('group', { alias => [qw'select group'] }); … … 153 237 $objenv->{_otype} = $otype; 154 238 $objenv->{_objects} = [ @objs ]; 239 $objenv->add_func('+', { 240 help => 'add item to selection', 241 code => sub { 242 my ($env, @ids) = @_; 243 my %ids = map { $_->id => 1 } @{$env->{_objects}}; 244 foreach (@ids) { 245 $ids{$_} and next; 246 my $o = $env->base->get_object($env->{_otype}, $_) or next; 247 push(@{$env->{_objects}}, $o); 248 } 249 printf $OUT "select is now %s: %s\n", $env->{_otype}, join(', ', map { 250 $_->id } @{$env->{_objects}}); 251 }, 252 completion => sub { 253 my ($env, undef, @ids) = @_; 254 my %ids = map { $_->id => 1 } @{$env->{_objects}}; 255 return ( grep { ! $ids{$_} } $env->base->list_objects($env->{_otype})); 256 }, 257 } 258 ); 259 $objenv->add_func('-', { 260 help => 'add item to selection', 261 code => sub { 262 my ($env, @ids) = @_; 263 my %ids = map { $_ => 1 } @ids; 264 my @newobjs = grep { !$ids{$_->id} } @{$env->{_objects}}; 265 266 if (!@newobjs) { 267 print $OUT "This would remove all objects from the list...\n"; 268 return; 269 } else { 270 @{$env->{_objects}} = @newobjs; 271 } 272 printf $OUT "select is now %s: %s\n", $env->{_otype}, join(', ', map { 273 $_->id } @{$env->{_objects}}); 274 }, 275 completion => sub { 276 my ($env, undef, @ids) = @_; 277 my %ids = map { $_ => 1 } @ids; 278 grep { !$ids{$_} } map { $_->id } @{$env->{_objects}}; 279 }, 280 } 281 ); 155 282 $objenv->add_func('show', { 156 283 help => 'show attributes - show an attributes of object', … … 177 304 code => sub { 178 305 my ($env, $fmt) = @_; 306 if (!defined($fmt)) { 307 print $OUT "no format given"; 308 return; 309 } 179 310 foreach (@{$env->{_objects}}) { 180 311 print $OUT $_->queryformat($fmt) . "\n"; … … 192 323 foreach (@{$env->{_objects}}) { 193 324 defined $_->set_c_fields($attr => undef) or do { 194 print $OUT "cannot unset attributes $attr for " . $_->id; 325 print $OUT "cannot unset attributes $attr for " . $_->id . 326 "\n"; 195 327 return; 196 328 }; 197 329 } 198 $env-> base->commit;199 print $OUT "Changes applied ";330 $env->commit; 331 print $OUT "Changes applied\n"; 200 332 }, 201 333 completion => sub { … … 211 343 my ($env, $attr, @value) = @_; 212 344 @value or do { 213 print $OUT "attribute and value must be specified ";345 print $OUT "attribute and value must be specified\n"; 214 346 return; 215 347 }; … … 218 350 \@value) or do { 219 351 $_->base->rollback; 220 printf $OUT "Cannot set $attr to %s for %s ", join(', ',352 printf $OUT "Cannot set $attr to %s for %s\n", join(', ', 221 353 @value), $_->id; 222 354 return; 223 355 }; 224 356 } 225 $env-> base->commit;226 print $OUT " done";357 $env->commit; 358 print $OUT "Done.\n"; 227 359 }, 228 360 completion => sub { … … 231 363 return $env->base->list_canonical_fields($env->{_otype}, 'w') 232 364 } else { 233 if ($env->base->obj_attr_allowed_values($env->{_otype}, $args[0])) { 234 return $env->base->obj_attr_allowed_values($env->{_otype}, $args[0]) 235 } 236 for ($args[0]) { 237 /^manager|managedBy$/ and return 238 $env->base->search_objects('user'); 239 /^department$/ and return 240 $env->base->search_objects('group', 'sutype=dpmt'); 241 /^contratType$/ and return 242 $env->base->search_objects('group', 'sutype=contrattype'); 243 /^site$/ and return 244 $env->base->search_objects('site'); 245 if (@{$env->{_objects}} == 1) { 246 return $env->{_objects}[0]->get_attributes($args[0]); 247 } 365 my $attr = $env->base->attribute($env->{_otype}, $args[0]); 366 if ($attr->has_values_list) { 367 $attr->can_values; 368 } elsif (@{$env->{_objects}} == 1) { 369 return 370 $env->{_objects}[0]->get_attributes($args[0]); 371 } 372 } 373 }, 374 }); 375 $objenv->add_func('add', { 376 help => 'add a value to an attribute', 377 code => sub { 378 my ($env, $attr, @value) = @_; 379 @value or do { 380 print $OUT "attribute and value must be specified\n"; 381 return; 382 }; 383 foreach (@{$env->{_objects}}) { 384 my @attrv = grep { $_ } $_->get_attributes($attr); 385 defined $_->set_c_fields($attr => [ @attrv, @value ]) or do { 386 $_->rollback; 387 printf $OUT "Cannot set $attr to %s for %s\n", join(', ', 388 @value), $_->id; 389 return; 390 }; 391 } 392 $env->commit; 393 print $OUT "done\n"; 394 }, 395 completion => sub { 396 my ($env, $lastw, @args) = @_; 397 if (!$args[0]) { 398 return grep { 399 $env->base->attribute($env->{_otype}, $_)->{multiple} 400 } $env->base->list_canonical_fields($env->{_otype}, 'w') 401 } else { 402 my $attr = $env->base->attribute($env->{_otype}, $args[0]); 403 if ($attr->has_values_list) { 404 $attr->can_values; 405 } elsif (@{$env->{_objects}} == 1) { 406 return 407 $env->{_objects}[0]->get_attributes($args[0]); 408 } 409 } 410 }, 411 }); 412 $objenv->add_func('remove', { 413 help => 'remove a value from an attribute', 414 code => sub { 415 my ($env, $attr, @value) = @_; 416 @value or do { 417 print $OUT "attribute and value must be specified\n"; 418 return; 419 }; 420 foreach (@{$env->{_objects}}) { 421 my @attrv = grep { $_ } $_->get_attributes($attr); 422 foreach my $r (@value) { 423 @attrv = grep { $_ ne $r } @attrv; 424 } 425 defined $_->set_c_fields($attr => @attrv ? [ @attrv ] : undef) or do { 426 $_->rollback; 427 printf $OUT "Cannot set $attr to %s for %s\n", join(', ', 428 @value), $_->id; 429 return; 430 }; 431 } 432 $env->commit; 433 print $OUT "done\n"; 434 }, 435 completion => sub { 436 my ($env, $lastw, @args) = @_; 437 if (!$args[0]) { 438 return grep { 439 $env->base->attribute($env->{_otype}, $_)->{multiple} 440 } $env->base->list_canonical_fields($env->{_otype}, 'w') 441 } else { 442 my $attr = $env->base->attribute($env->{_otype}, $args[0]); 443 if (@{$env->{_objects}} == 1) { 444 return 445 $env->{_objects}[0]->get_attributes($args[0]); 248 446 } 249 447 } … … 253 451 help => 'list current selected objects', 254 452 code => sub { 255 printf $OUT "%s: %s ", $_[0]->{_otype}, join(', ', map { $_->id }453 printf $OUT "%s: %s\n", $_[0]->{_otype}, join(', ', map { $_->id } 256 454 @{$_[0]->{_objects}}); 257 455 } … … 267 465 if ($id) { 268 466 $obj = grep { $_->id = $id } @{$env->{_objects}} or do { 269 print $OUT "$id is not part of selected objects ";467 print $OUT "$id is not part of selected objects\n"; 270 468 return; 271 469 }; … … 274 472 } else { 275 473 print $OUT "multiple objects selected but can edit only one," 276 . "please specify which one ";474 . "please specify which one\n"; 277 475 return; 278 476 } … … 292 490 my $res = $obj->set_c_fields(%attr); 293 491 if ($res) { 294 print $OUT "Changes applied ";295 $env-> base->commit;492 print $OUT "Changes applied\n"; 493 $env->commit; 296 494 } 297 else { print $OUT "Error applying changes " }495 else { print $OUT "Error applying changes\n" } 298 496 return $res ? 1 : 0; 299 497 } … … 305 503 code => sub { 306 504 my ($env) = @_; 307 printf $OUT "%s: %s\ndelete selected objects ? (yes/NO) 505 printf $OUT "%s: %s\ndelete selected objects ? (yes/NO)\n", 308 506 $env->{_otype}, join(', ', map { $_->id } @{$env->{_objects}}); 309 507 my $reply = <STDIN> || ''; chomp($reply); … … 311 509 foreach (@{$env->{_objects}}) { 312 510 $env->base->delete_object($env->{_otype}, $_->id) or do { 313 print $OUT "Cannot delete " . $_->id ;511 print $OUT "Cannot delete " . $_->id . "\n"; 314 512 return; 315 513 }; 316 514 } 317 $env-> base->commit;515 $env->commit; 318 516 return "EXIT"; 319 517 } else { 320 print $OUT "cancel !" 321 } 322 }, 323 }); 518 print $OUT "cancel !\n" 519 } 520 }, 521 }); 522 if (grep { $objenv->base->attribute($otype, $_)->reference } 523 $objenv->base->list_canonical_fields($otype, 'r')) { 524 $objenv->add_func('select', { 525 help => 'select attribute [object]', 526 code => sub { 527 my ($env, $attrname, @objects) = @_; 528 my $totype = $env->base->attribute($env->{_otype}, 529 $attrname)->reference or return; 530 531 if (! @objects) { 532 @objects = grep { $_ } 533 map { $_->get_attributes($attrname) } @{$env->{_objects}}; 534 } 535 { 536 my %uniq = map { $_ => 1 } @objects; 537 @objects = keys %uniq; 538 } 539 my @objs = (grep { $_ } map { $env->base->get_object($totype, $_) } 540 @objects); 541 return if (!@objs); 542 print $OUT "Selecting $otype " . join(', ', map { $_->id } @objs) . "\n"; 543 objenv($_[0]->base, $totype, @objs)->cli(); 544 }, 545 completion => sub { 546 if ($_[2]) { 547 my $totype = $_[0]->base->attribute($_[0]->{_otype}, 548 $_[2])->reference or return; 549 return grep { $_ } 550 map { $_->get_attributes($_[2]) } 551 @{$_[0]->{_objects}}; 552 } else { 553 return grep { $_[0]->base->attribute($otype, $_)->reference } 554 $_[0]->base->list_canonical_fields($otype, 'r'); 555 } 556 }, 557 } 558 ); 559 } 324 560 325 561 if (lc($otype) eq 'user') { … … 334 570 my $gobj = $env->base->get_object('group', $gid) or 335 571 do { 336 print $OUT "Cannot find group $gid ";572 print $OUT "Cannot find group $gid\n"; 337 573 return; 338 574 }; … … 350 586 delete($gr{$_}) foreach(@groups); 351 587 } else { 352 print $OUT 'invalid action' ;588 print $OUT 'invalid action' . "\n"; 353 589 return; 354 590 } 355 591 defined $obj->set_c_fields('memberOf' => [ keys %gr ]) or do { 356 592 print $OUT "cannot set memberOf attributes for " . 357 $obj->id ;593 $obj->id . "\n"; 358 594 return; 359 595 }; 360 596 } 361 597 } 362 $env-> base->commit;598 $env->commit; 363 599 }, 364 600 completion => sub { … … 366 602 return (qw(add remove primary)); 367 603 } else { 368 return $_[0]->base->search_objects('group'); 604 if ($_[2] eq 'remove') { 605 my %uniq = map { $_ => 1 } 606 grep { $_ } 607 map { $_->get_attributes('memberOf') } 608 @{$_[0]->{_objects}}; 609 return sort keys %uniq; 610 } else { 611 return $_[0]->base->search_objects('group'); 612 } 369 613 } 370 614 }, … … 385 629 delete($gr{$_}) foreach(@groups); 386 630 } else { 387 print $OUT 'invalid action' ;631 print $OUT 'invalid action' . "\n"; 388 632 return; 389 633 } 390 634 defined $obj->set_c_fields('memberUID' => [ keys %gr ]) or do { 391 635 print $OUT "cannot set memberUID attributes for " . 392 $obj->id ;636 $obj->id . "\n"; 393 637 return; 394 638 }; 395 639 } 396 $env-> base->commit;640 $env->commit; 397 641 }, 398 642 completion => sub { … … 400 644 return (qw(add remove)); 401 645 } else { 402 return $_[0]->base->search_objects('user'); 646 if ($_[2] eq 'remove') { 647 my %uniq = map { $_ => 1 } 648 grep { $_ } 649 map { $_->get_attributes('member') } 650 @{$_[0]->{_objects}}; 651 return sort keys %uniq; 652 } else { 653 return $_[0]->base->search_objects('user'); 654 } 403 655 } 404 656 }, … … 413 665 bless($env, $class); 414 666 $env->{_labase} = $labase; 667 668 if ($labase->is_transactionnal) { 669 $env->add_func( 670 'transaction', { 671 help => 'change transaction mode', 672 code => sub { 673 $trans_mode = $_[1] eq 'on' ? 1 : 0; 674 }, 675 completion => sub { 676 $trans_mode == 0 ? 'on' : 'off'; 677 }, 678 } 679 ); 680 $env->add_func( 681 'commit', { 682 help => 'commit pending change', 683 code => sub { 684 $_[0]->_commit; 685 }, 686 } 687 ); 688 $env->add_func( 689 'rollback', { 690 help => 'commit pending change', 691 code => sub { 692 $_[0]->_rollback; 693 }, 694 } 695 ); 696 } 415 697 $env->add_func('quit', { help => 'quit - exit the tool', 416 698 code => sub { print "\n"; exit(0) }, }); … … 425 707 my ($self, $name) = @_; 426 708 if (!$name) { 427 print $OUT join(', ', sort keys %{ $self->{funcs} || {}}) ;709 print $OUT join(', ', sort keys %{ $self->{funcs} || {}}) . "\n"; 428 710 } elsif ($self->{funcs}{$name}{alias}) { 429 711 print $OUT "$name is an alias for " . join(' ', 430 @{$self->{funcs}{$name}{alias}}) ;712 @{$self->{funcs}{$name}{alias}}) . "\n"; 431 713 } elsif ($self->{funcs}{$name}{help}) { 432 print $OUT $self->{funcs}{$name}{help} ;714 print $OUT $self->{funcs}{$name}{help} . "\n"; 433 715 } else { 434 print $OUT "No help availlable ";716 print $OUT "No help availlable\n"; 435 717 } 436 718 }, … … 448 730 $self->complete($_[0], shellwords(substr($_[1], 0, $_[2]))); 449 731 }; 450 defined (my $line = $term->readline($self->prompt)) or return; 732 defined (my $line = $term->readline($self->prompt)) or do { 733 print $OUT "\n"; 734 return; 735 }; 736 $term->addhistory($line); 451 737 my $res = $self->run(shellwords($line)); 452 $self-> base->rollback;453 if ($res && $res eq 'EXIT') { return }738 $self->rollback if (!$trans_mode); 739 if ($res && $res eq 'EXIT') { print $OUT "\n"; return } 454 740 } 455 741 } … … 469 755 } 470 756 757 sub getoption { 758 my ($self, $opt, @args) = @_; 759 local @ARGV = @args; 760 Getopt::Long::Configure("pass_through"); 761 GetOptions(%{ $opt }); 762 763 return @ARGV; 764 } 765 471 766 sub parse_arg { 472 767 my ($self, $name, @args) = @_; 473 if ($self->{funcs}{$name}{opt}) { 474 @ARGV = @args; 475 } else { 476 return @args; 477 } 478 return @ARGV; 768 return @args; 479 769 } 480 770 … … 497 787 my ($self, $name, @args) = @_; 498 788 return if (!$name); 499 if ($self->{funcs}{$name}{alias}) { 789 if (!exists($self->{funcs}{$name})) { 790 print $OUT "No command $name found\n"; 791 } elsif ($self->{funcs}{$name}{alias}) { 500 792 $self->run(@{$self->{funcs}{$name}{alias}}, @args); 501 793 } elsif ($self->{funcs}{$name}{code}) { 502 794 my @pargs = $self->parse_arg($name, @args); 503 795 $self->{funcs}{$name}{code}->($self, @args); 796 } else { 797 print $OUT "No command $name found\n"; 504 798 } 505 799 } 506 800 801 sub commit { 802 my ($self) = @_; 803 if ($trans_mode) { 804 } else { 805 $self->_commit; 806 } 807 } 808 809 sub _commit { 810 my ($self) = @_; 811 $self->base->commit; 812 } 813 814 sub rollback { 815 my ($self) = @_; 816 if ($trans_mode) { 817 print $OUT "All pending changes get rollback\n"; 818 } 819 $self->_rollback; 820 } 821 822 sub _rollback { 823 my ($self) = @_; 824 $self->base->rollback; 825 } 826 507 827 1; -
LATMOS-Accounts/lib/LATMOS/Accounts/Log.pm
r476 r861 5 5 use Sys::Syslog qw(:standard :macros); 6 6 use Exporter (); 7 use Mail::Sendmail; 7 8 8 9 =head1 NAME … … 113 114 console => LA_NOTICE, 114 115 callback => undef, 116 mail => undef, 115 117 ); 118 119 my @maillog = (); 116 120 117 121 =head1 FUNCTIONS … … 154 158 sub lastmessage { 155 159 my ($level) = @_; 156 return $lastmessages{$level };160 return $lastmessages{$level || LA_ERROR}; 157 161 } 158 162 … … 186 190 $log_method{callback}->($level, $msg, @args); 187 191 } 192 if ($log_method{mail}) { 193 # store error to send it later, only ERROR 194 push(@maillog, sprintf($msg, @args)) if ($level <= LA_ERROR); 195 } 188 196 1; 189 197 } 190 198 199 sub _flush_mail { 200 @maillog = (); 201 } 202 203 sub _send_mail_log { 204 @maillog or return; 205 sendmail( 206 Subject => "LATMOS::Accounts error from $0", 207 To => $log_method{mail}, 208 From => 'LATMOS-Accounts@latmos.ipsl.fr', 209 Message => join("\n", @maillog), 210 ) or la_log(LA_ERR, "Cannot sent mail: " . $Mail::Sendmail::error); 211 _flush_mail(); 212 } 213 214 END { 215 _send_mail_log() if($log_method{mail}); 216 } 217 191 218 1; -
LATMOS-Accounts/lib/LATMOS/Accounts/Maintenance.pm
r850 r861 6 6 use LATMOS::Accounts::Log; 7 7 use FindBin qw($Bin); 8 use Crypt::RSA;9 use Crypt::RSA::Key::Public::SSH;10 use Crypt::RSA::Key::Private::SSH;11 use MIME::Base64;12 8 13 9 sub _base { 14 10 my ($self) = @_; 11 return $self->{_maintenance_base} if ($self->{_maintenance_base}); 15 12 my $base = $self->SUPER::default_base; 16 13 $base->type eq 'sql' or die "This module work only with SQL base type\n"; 17 $base14 return $self->{_maintenance_base} = $base 18 15 } 19 16 20 17 sub find_next_expire_users { 21 18 # Do not replace this code by $base->find_next_expire_users 22 # it does not ex ctly the same thing19 # it does not exactly the same thing 23 20 my ($self, $expire) = @_; 24 21 my $base = $self->_base; … … 184 181 } 185 182 183 sub expired_account_reminder { 184 my ($self, %options) = @_; 185 $options{delay} ||= '6 month'; 186 187 require Mail::Sendmail; 188 require Template; 189 190 my $template = Template->new( 191 INCLUDE_PATH => [ 192 ($self->val('_default_', 'templatespath') 193 ? $self->val('_default_', 'templatespath') . '/mail' 194 : ()), 195 "$FindBin::Bin/../templates" . '/mail', 196 '/usr/share/latmos-accounts/templates/mail', 197 ], 198 POST_CHOMP => 1, 199 EXTENSION => '.mail', 200 ); 201 202 my @users = $self->_base->find_expired_users($options{delay}); 203 204 my %managers; 205 foreach my $user (@users) { 206 my $uobj = $self->_base->get_object('user', $user); 207 $uobj->get_attributes('unexported') and next; # can't happend 208 my $manager = $uobj->get_attributes('managerContact') || 'N/A'; 209 push(@{$managers{$manager}{users}}, $uobj); 210 } 211 212 foreach (keys %managers) { 213 my $oman = $self->_base->get_object('user', $_) or next; # can't happend 214 $managers{$_}{manager} = $oman; 215 my $mail = $oman->get_attributes('mail') or next; 216 217 my %mail = ( 218 From => $self->val('_default_', 'mailFrom', 'nomail@localhost'), 219 Subject => 'LATMOS expired account', 220 smtp => $self->val('_default_', 'smtp'), 221 'Content-Type' => 'text/plain; charset=utf-8', 222 'X-LATMOS-Accounts' => '$Rev$', 223 'X-LATMOS-Reason' => 'Account expiration', 224 ); 225 $mail{to} = $options{to} || $mail; 226 my $message; 227 $template->process('account_expired_reminder.mail', $managers{$oman->id}, \$message) 228 or do { 229 la_log(LA_ERR, "Cannot send expiration mail: %s, exiting", 230 $template->error()); 231 exit(1); 232 }; 233 234 if (!$options{test}) { 235 if (Mail::Sendmail::sendmail( 236 %mail, 237 Message => $message, 238 )) { 239 la_log(LA_NOTICE, 240 "Expired account reminder mail for %s sent to %s (cc: %s) for %s", 241 $oman->id, 242 $mail{to}, 243 ($mail{cc} || ''), 244 join(', ', map { $_->id } @{$managers{$oman->id}{users}}) 245 ); 246 } else { 247 la_log(LA_ERR, "Cannot send mail: %s", $Mail::Sendmail::error); 248 } 249 } 250 } 251 my @summary; 252 foreach my $manager (sort keys %managers) { 253 push(@summary, "\n" . ( 254 $managers{$manager}{manager} 255 ? $managers{$manager}{manager}->get_attributes('displayName') 256 : $manager) . "\n"); 257 foreach (@{$managers{$manager}{users}}) { 258 push(@summary, sprintf(" %s - %s (%s)\n", 259 $_->id, 260 $_->get_attributes('displayName'), 261 $_->get_attributes('expireText'), 262 )); 263 } 264 } 265 266 if (@summary) { 267 if ($options{test}) { 268 print join('', @summary); 269 } else { 270 if ($self->val('_default_', 'expire_summary_to')) { 271 my %mail = ( 272 From => $self->val('_default_', 'mailFrom', 'nomail@localhost'), 273 Subject => 'LATMOS expired account (to disable)', 274 smtp => $self->val('_default_', 'smtp'), 275 'Content-Type' => 'text/plain; charset=utf-8', 276 'X-LATMOS-Accounts' => '$Rev$', 277 'X-LATMOS-Reason' => 'Account expiration', 278 To => $self->val('_default_', 'expire_summary_to'), 279 ); 280 if (Mail::Sendmail::sendmail( 281 %mail, 282 Message => join('', @summary), 283 )) { 284 la_log(LA_NOTICE, "Expiration summary mail sent to %s", 285 $self->val('_default_', 'expire_summary_to'), 286 ); 287 } else { 288 la_log(LA_ERR, "Cannot send mail: %s", $Mail::Sendmail::error); 289 } 290 } 291 } 292 } 293 } 294 186 295 sub generate_rsa_key { 296 # compat functions 187 297 my ($self, $password) = @_; 188 189 my $rsa = new Crypt::RSA ES => 'PKCS1v15'; 190 my ($public, $private) = $rsa->keygen ( 191 Identity => 'LATMOS-Accounts', 192 Size => 768, 193 Password => $password, 194 Verbosity => 0, 195 KF=>'SSH', 196 ) or die 197 $self->rsa->errstr(); # TODO avoid die 198 return ($public, $private); 199 } 298 $self->_base->generate_rsa_key($password); 299 } 300 200 301 201 302 sub store_rsa_key { 303 # compat functions 202 304 my ($self, $public, $private) = @_; 203 my $base = $self->_base; 204 $base->set_global_value('rsa_private_key', 205 encode_base64($private->serialize)); 206 $base->set_global_value('rsa_public_key', 207 $public->serialize); 208 return; 305 $self->_base->store_rsa_key($public, $private); 209 306 } 210 307 211 308 sub private_key { 309 # compat functions 212 310 my ($self, $password) = @_; 213 my $base = $self->_base; 214 my $serialize = $base->get_global_value('rsa_private_key') or return; 215 my $privkey = Crypt::RSA::Key::Private::SSH->new; 216 $privkey->deserialize(String => [ decode_base64($serialize) ], 217 Passphrase => $password); 218 $privkey 311 $self->_base->private_key($password); 219 312 } 220 313 221 314 sub get_rsa_password { 315 # compat functions 222 316 my ($self) = @_; 223 my $base = $self->_base; 224 my $sth = $base->db->prepare(q{ 225 select "name", value from "user" join user_attributes_base 226 on "user".ikey = user_attributes_base.okey 227 where user_attributes_base.attr = 'encryptedPassword' 228 }); 229 $sth->execute; 230 my %users; 231 while (my $res = $sth->fetchrow_hashref) { 232 $users{$res->{name}} = $res->{value}; 233 } 234 %users 317 $self->_base->get_rsa_password; 235 318 } 236 319 -
LATMOS-Accounts/lib/LATMOS/Accounts/SynchAccess/base.pm
r715 r861 24 24 my ($class, $bases) = @_; 25 25 bless { 26 bases => [ @{ $bases } ],26 bases => [ @{ $bases } ], 27 27 }, $class; 28 28 } -
LATMOS-Accounts/lib/LATMOS/Accounts/Synchro.pm
r819 r861 124 124 $self->load_dest and return; 125 125 my %state = (); 126 $state{$self->from->label} = $self->from->wexported(0); 126 $state{$self->from->label} = $self->from->wexported( 127 $self->{options}{unexported} ? 1 : 0 128 ); 127 129 foreach ($self->to) { 128 130 $state{$_->label} = $_->wexported(1); … … 137 139 la_log(LA_DEBUG, "Leaving synch mode"); 138 140 $self->from->wexported($state{$self->from->label}); 139 foreach ($self->to) {140 $ _->commit;141 $ _->wexported($state{$_->label});141 foreach my $base (grep { $_ } $self->to) { 142 $base->commit; 143 $base->wexported($state{$base->label}); 142 144 } 143 145 } … … 205 207 206 208 $self->lock or return; 209 210 if (!(my $res = $self->run_pre_synchro({}))) { 211 la_log(LA_ERR, "Pre synchro script failed, aborting"); 212 $self->unlock; 213 return; 214 } 207 215 208 216 my %state = $self->enter_synch_mode; … … 230 238 $self->from->label, $otype, $_, $destbase->label, $res, 231 239 ); 240 if ($destbase->is_transactionnal) { 241 $destbase->commit; 242 } 232 243 $updated = 1; 244 } else { 245 if ($destbase->is_transactionnal) { 246 $destbase->rollback; 247 } 233 248 } 234 249 } … … 241 256 } 242 257 foreach my $pass (1, 0) { 243 foreach my $otype ( 244 sort { $a eq 'user' ? 1 : -1 } # user in last because gidNumber needed 245 keys %objlist) { 246 next if (!$pass && !$destbase->delayed_fields($otype)); 258 foreach my $otype ($destbase->ordered_objects) { 259 exists($objlist{$otype}) or next; 247 260 foreach (@{$objlist{$otype} || []}) { 248 261 my $res = $destbase->sync_object_from($self->from, $otype, $_, … … 254 267 $destbase->label, $res, 255 268 ); 269 if ($destbase->is_transactionnal) { 270 $destbase->commit; 271 } 256 272 $updated = 1; 257 273 } … … 262 278 ); 263 279 $desterror{$destbase->label} = 1; 280 if ($destbase->is_transactionnal) { 281 $destbase->rollback; 282 } 264 283 } 265 284 … … 272 291 my $res = $self->run_post_synchro( 273 292 { 274 UPDATED => $updated ,293 UPDATED => $updated || undef, 275 294 } 276 295 ); … … 313 332 } 314 333 334 sub run_pre_synchro { 335 my ($self, $env) = @_; 336 337 $env ||= {}; 338 $env->{HOOK_TYPE} = 'PRE'; 339 340 foreach my $base ($self->to) { 341 if ($base->options('presynchro')) { 342 la_log LA_DEBUG, "Executing base pre synchro `%s' for %s", 343 $base->options('presynchro'), $base->label; 344 exec_command( 345 $base->options('presynchro'), 346 { 347 BASE => $base->label, 348 BASETYPE => $base->type, 349 %{ $env }, 350 } 351 ); 352 } 353 } 354 355 $self->{options}{pre} or return 1; 356 357 la_log(LA_DEBUG, "Running post synchro `%s'", $self->{options}{pre}); 358 359 exec_command($self->{options}{post}, $env); 360 } 361 315 362 sub run_post_synchro { 316 363 my ($self, $env) = @_; 364 365 $env ||= {}; 366 $env->{HOOK_TYPE} = 'PRE'; 367 368 foreach my $base ($self->to) { 369 if ($base->options('postsynchro')) { 370 la_log LA_DEBUG, "Executing base post synchro `%s' for %s", 371 $base->options('postsynchro'), $base->label; 372 exec_command( 373 $base->options('postsynchro'), 374 { 375 BASE => $base->label, 376 BASETYPE => $base->type, 377 %{ $env }, 378 } 379 ); 380 } 381 } 317 382 318 383 $self->{options}{post} or return 1; 319 384 320 la_log(LA_ INFO, "Running post synchro `%s'", $self->{options}{post});321 385 la_log(LA_DEBUG, "Running post synchro `%s'", $self->{options}{post}); 386 322 387 exec_command($self->{options}{post}, $env); 323 388 } -
LATMOS-Accounts/lib/LATMOS/Accounts/Utils.pm
r818 r861 12 12 13 13 @ISA = qw(Exporter); 14 @EXPORT = qw(to_ascii exec_command );15 @EXPORT_OK = qw(to_ascii exec_command );14 @EXPORT = qw(to_ascii exec_command switch_user run_via_sudo); 15 @EXPORT_OK = qw(to_ascii exec_command switch_user run_via_sudo); 16 16 17 17 sub to_ascii { … … 21 21 $text =~ s/Å/oe/g; 22 22 $text =~ s/Ê/ae/g; 23 $text =~ tr {uà âÀÃÃÃçéÚêëÃÃÃÃïîÃÃÞöÎÃÃÌûÃà }24 {uaaaAAAceeeeEEEEiiIIoooOOuuUU };23 $text =~ tr {uà âÀÃÃÃçéÚêëÃÃÃÃïîÃÃÞöÎÃÃÌûÃÃÄ} 24 {uaaaAAAceeeeEEEEiiIIoooOOuuUUc}; 25 25 $text =~ s/([^[:ascii:]])/_/g; 26 26 $text … … 29 29 sub exec_command { 30 30 my ($command, $env) = @_; 31 my $rout = undef; 32 $rout = \$_[2] if(@_ > 2); 31 33 32 34 my @exec = ref $command … … 35 37 la_log(LA_DEBUG, 'running command `%s\'', join(' ', @exec)); 36 38 39 pipe(my $rh, my $wh); 37 40 my $pid = fork; 38 41 if (!defined($pid)) { … … 40 43 } elsif ($pid) { 41 44 # Father 45 close($wh); 46 my $header; 47 while (<$rh>) { 48 if ($rout) { 49 $$rout .= $_; 50 } else { 51 chomp; 52 if (!$header) { 53 $header = 1; 54 la_log(LA_NOTICE, "exec `%s'", join(' ', @exec)); 55 } 56 la_log(LA_NOTICE, "output: %s", $_); 57 } 58 } 42 59 waitpid($pid, 0); 43 60 if (my $exitstatus = $?) { … … 50 67 } else { 51 68 # Child 69 close($rh); 70 ( $ENV{LA_MODULE} ) = caller(); 52 71 foreach (keys %{ $env || {} }) { 53 72 $ENV{"LA_$_"} = $env->{$_}; 54 73 } 74 open(STDOUT, ">&=" . fileno($wh)); 75 open(STDERR, ">&=" . fileno($wh)); 55 76 exec(@exec); 56 77 exit($!); … … 78 99 } 79 100 } else { 80 $attributes{$attr} = $value || undef; 81 $attr eq 'exported' && !defined $attributes{$attr} and $attributes{$attr} = 1; 101 $attributes{$attr} = $value eq '' ? undef : $value; 102 # Don't remember why this is here 103 #$attr eq 'exported' && !defined $attributes{$attr} and $attributes{$attr} = 1; 82 104 } 83 105 } … … 129 151 if ($name !~ /^[a-z]/); 130 152 return "must contain only a-z,0-9" 131 if ($name !~ /^[a-z,0-9 ]+$/);153 if ($name !~ /^[a-z,0-9,_,-]+$/); 132 154 133 155 return check_oid_validity($name); 134 156 } 135 157 158 sub switch_user { 159 my ($runas) = @_; 160 161 if ($< == 0 || $> == 0) { 162 my @info = getpwnam($runas) or do { 163 warn "Can find user $runas"; 164 return; 165 }; 166 $> = $info[3]; 167 return; 168 } else { 169 warn "we are not root"; 170 } 171 } 172 173 sub run_via_sudo { 174 my ($runas) = @_; 175 176 my @info = getpwnam($runas) or do { 177 warn "Can find user $runas"; 178 return; 179 }; 180 if ($< != $info[3]) { 181 exec('sudo', '-u', $runas, $0, @ARGV) or "Can run $!"; 182 } 183 } 184 136 185 1;
Note: See TracChangeset
for help on using the changeset viewer.