gosa-perl/0000755000175000017500000000000011330025416012264 5ustar benoitbenoitgosa-perl/GOsa/0000755000175000017500000000000011330025421013111 5ustar benoitbenoitgosa-perl/GOsa/FAI.pm0000644000175000017500000014117611326407245014075 0ustar benoitbenoit# Copyright (c) 2008 Landeshauptstadt München # # Author: Jan-Marek Glogowski # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . package GOsa::FAI; use strict; use warnings; use Data::Dumper; use Net::LDAP; use File::Path; use Switch; use GOsa::Common qw(:ldap :misc); BEGIN { use Exporter (); use vars qw(%EXPORT_TAGS @ISA $VERSION); $VERSION = '2008-04-08_01'; @ISA = qw(Exporter); %EXPORT_TAGS = ( 'flags' => [qw( FAI_FLAG_VERBOSE FAI_FLAG_DRY_RUN FAI_FLAG_NO_COW )] ); Exporter::export_ok_tags(keys %EXPORT_TAGS); } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Prepare LDAP filter to include 'gosaUnitTag' and 'FAIstate' # sub prepare_filter { my( $self, $filter ) = @_; return $filter if( '' eq $filter ); $filter = '(' . $filter . ')' if( '(' ne substr( $filter, 0, 1 ) ); if( defined $self->{ 'tag' } ) { return( "(&$filter(|(gosaUnitTag=" . $self->{ 'tag' } . ')(FAIstate=*freeze*)))' ); } return $filter; } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Constructor for GOsa::FAI object # # $ldap = Net::LDAP handle # %options = Hash of options like (Net::LDAP) # sub new { my $self = shift; my $type = ref($self) || $self; my $args = &gosa_options_parse; my $obj = bless {}, $type; $obj->{ 'LDAP' } = undef; $obj->{ 'flags' } = 0; foreach my $arg (keys %$args) { $obj->{ $arg } = $args->{ $arg }; } return $obj; } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Get or set Net::LDAP handle # sub handle { my( $self, $ldap ) = @_; if( defined $ldap ) { return undef if( ! $ldap->isa( 'Net::LDAP' ) ); $self->{ 'LDAP' } = $ldap; } else { return $self->{ 'LDAP' }; } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Get or set LDAP base DN # sub base { my( $self, $base ) = @_; if( defined $base ) { $self->{ 'base' } = $base; } else { return $self->{ 'base' }; } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Get or set the dump directory # sub dumpdir { my( $self, $dumpdir ) = @_; if( defined $dumpdir ) { $self->{ 'dumpdir' } = $dumpdir; } else { return $self->{ 'dumpdir' }; } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Get or set GOsa unit tag # sub tag { my( $self, $tag ) = @_; if( defined $tag ) { if( 0 > $tag ) { delete( $self->{ 'tag' } ); return; } $self->{ 'tag' } = $tag; } elsif( exists $self->{ 'tag' } ) { return $self->{ 'tag' }; } return undef; } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Get or set class flags # # Prints progress information to stdout use constant FAI_FLAG_VERBOSE => 1; # Suppresses any data use constant FAI_FLAG_DRY_RUN => 2; # Ignores COW, so the "real" release will be dumped use constant FAI_FLAG_NO_COW => 4; sub flags { my( $self, $flags ) = @_; if( defined $flags ) { if( 0 > $flags ) { $self->{ 'flags' } = 0; return; } $self->{ 'flags' } = $flags; } elsif( exists $self->{ 'flags' } ) { return $self->{ 'flags' }; } return undef; } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # $self = GOsa::FAI handle # $release = Release version # $force = Ignore cached values and recheck # # Returns \@rdns, \@releases # The versions RDNs and their corresponding release name. # sub release_check { my( $self, $release, $force ) = @_; my( $mesg, $entry ); my $fai_base = 'ou=fai,ou=configs,ou=systems'; my @result_rdns; my @check_rdns = (); my @check_releases = (); my $rdn; my $len; my $norm_release = $release; $norm_release =~ s/\./\//g; # Return cached values if not enforced if( ! defined $force && $force ) { return $self->{ 'CHECKS' }{ $norm_release } if( exists $self->{ 'CHECKS' }{ $norm_release } ); } my $ldap = $self->{ 'LDAP' }; my $base = $self->{ 'base' }; # New COW based tree - split at '/' ans '.' $rdn = $fai_base; $len = -1; foreach my $part (split( /[\.\/]/, $release )) { $rdn = "ou=$part," . $rdn; $len += length( $part ) + 1; unshift( @check_rdns, $rdn ); unshift( @check_releases, substr( $release, 0, $len ) ); } $mesg = $ldap->search( base => "$rdn,$base", filter => "(objectClass=FAIbranch)", attrs => [ 'ou', 'FAIstate' ], scope => 'base' ); if( 32 == $mesg->code ) { # Old full release - split at '/' @check_rdns = (); @check_releases = (); $rdn = $fai_base; $len = -1; foreach my $part (split( "/", $release )) { $rdn = "ou=$part," . $rdn; $len += length( $part ) + 1; unshift( @check_rdns, $rdn ); unshift( @check_releases, substr( $release, 0, $len ) ); } } # Walk tree until we find a non-cow release my $full_base = 0; foreach my $part (@check_rdns) { $mesg = $ldap->search( base => "$part,$base", filter => "(objectClass=FAIbranch)", attrs => [ 'ou', 'FAIstate' ], scope => 'base'); $mesg->code && return( sprintf( "Release not found (%s)!" . " Release LDAP base not accessible (%s) - LDAP error: %s", $release, "$part,$base", $mesg->error ) ); push( @result_rdns, $part ); # All FAIbranch'es of COW releases have a "cow" in their FAIstate # The Branch without the "cow" is the base release my $state = ($mesg->entries())[0]->get_value( 'FAIstate' ); my %states = map { $_ => 1 } split( "\\|", $state ) if( defined $state ); if( (! defined $state) || (! exists $states{ 'cow' }) ) { $full_base = 1; @check_releases = splice( @check_releases, 0, scalar @result_rdns + 1 ); last; } } return( sprintf( "No release base for (%s) found!", $release ) ) if( ! $full_base ); $self->{ 'CHECKS' }->{ $norm_release } = [ \@result_rdns, \@check_releases ]; return( \@result_rdns, \@check_releases ); } my %fai_items = ( 'debconf' => [ undef, 'FAIdebconfInfo' ], 'disk' => [ 'FAIpartitionTable', undef ], # FAIpartitionDisk, FAIpartitionEntry 'hooks' => [ 'FAIhook', 'FAIhookEntry', 'cn', 'FAItask', 'FAIscript' ], 'packages' => [ 'FAIpackageList', 'FAIpackageList' ], 'profiles' => [ 'FAIprofile' ], 'scripts' => [ 'FAIscript', 'FAIscriptEntry', 'cn', 'FAIpriority', 'FAIscript' ], 'templates' => [ 'FAItemplate', 'FAItemplateEntry' ], 'variables' => [ 'FAIvariable', 'FAIvariableEntry', 'cn', 'FAIvariableContent' ], ); # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # $self = GOsa::FAI handle # $release = Release version # $flags = Bit flags for cache lookup # FAI_CACHE_GENERATE = generate cache if not available # FAI_CACHE_FORCE = force cache regeneration # Defaults to FAI_CACHE_GENERATE. # # Returns a hashref including the classes for the FAI types # $result->{ ''profile', 'hook', ... }->{ 'class' } # In case of profiles it points to a hashref of profile subclasses # use constant FAI_CACHE_GENERATE => 1; use constant FAI_CACHE_FORCE => 2; sub get_class_cache { my( $self, $release, $flags ) = @_; # Set variables from flags $flags = 1 if( ! defined $flags ); my $generate = $flags & FAI_CACHE_GENERATE ? 1 : 0; my $force = $flags & FAI_CACHE_FORCE ? 1 : 0; # Normalize release name my $norm_release = $release; $norm_release =~ s/\./\//g; # Return cached values if not enforced or looked up if( !$force ) { return $self->{ 'FAI_TREES' }{ $norm_release } if( exists $self->{ 'FAI_TREES' }{ $norm_release } ); return undef if( ! $generate ); } return $self->generate_class_cache( $release, $force ); } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # $self = GOsa::FAI handle # $release = Release version # # Returns a hashref including the classes for the FAI types # $result->{ ''profile', 'hook', ... }->{ 'class' } # In case of profiles it points to a hashref of profile subclasses # # It totally ignores COW release dependencies @see gosa_fai_merge_cow_release # sub generate_class_cache { my( $self, $release, $force ) = @_; my %cache = (); my( $rdns, $releases ) = $self->release_check( $release, $force ); return $rdns if( ref( $rdns ) ne 'ARRAY' ); # Normalize release name my $norm_release = $release; $norm_release =~ s/\./\//g; my $ldap = $self->{ 'LDAP' }; my $base = $self->{ 'base' }; # Check all FAI OUs for classnames while( my( $type, $class ) = each %fai_items) { # We skip debconf infos next if( ! defined @{$class}[0] ); my $mesg = $ldap->search( base => "ou=${type},@{$rdns}[0],${base}", filter => $self->prepare_filter( '(objectClass=' . @{$class}[0] . ')' ), scope => 'one', attrs => [ 'cn', 'FAIclass', 'FAIstate' ]); next if( 32 == $mesg->code ); # Skip non-existent objects return( "LDAP search error: " . $mesg->error . ' (' . $mesg->code . ")\n" ) if( 0 != $mesg->code ); $cache{ $type } = (); next if( 0 == $mesg->count ); if( $type eq 'profiles' ) { next if( 0 == $mesg->count ); foreach my $entry ($mesg->entries()) { my $cn = $entry->get_value( 'cn' ); my $classlist_str = $entry->get_value( 'FAIclass' ); $cache{ $type }{ $cn }{ '_classes' } = (); $cache{ $type }{ $cn }{ '_state' } = $entry->get_value( 'FAIstate' ); foreach my $profile_class (split( ' ', $classlist_str )) { if( ":" eq substr( $profile_class, 0, 1 ) ) { warn( "Release '$cn' found in profile '$class' of '$release'." ); } else { push( @{$cache{ $type }{ $cn }{ '_classes' }}, $profile_class ); } } } } else { foreach my $entry ($mesg->entries()) { $cache{ $type }{ $entry->get_value( 'cn' ) } = undef; $cache{ 'debconf' }{ $entry->get_value( 'cn' ) } = undef if( 'packages' eq $type ); } } } $self->{ 'FAI_TREES' }{ $norm_release } = \%cache; return \%cache; } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # $self = GOsa::FAI handle # # Quick fill of the class cache for all releases. # This fuction needs just two LDAP queries to fill the whole class cache. # sub fill_class_cache { my( $self ) = @_; my $ldap = $self->{ 'LDAP' }; my $base = 'ou=fai,ou=configs,ou=systems,' . $self->{ 'base' }; # Get all releases my $mesg = $ldap->search( base => $base, filter => $self->prepare_filter( '(objectClass=FAIbranch)' ), scope => 'sub', attrs => [ 'dn' ] ); return( "LDAP search error: " . $mesg->error . ' (' . $mesg->code . ")\n" ) if( 0 != $mesg->code ); my @objects = $mesg->entries(); my %releases; foreach my $branch ($mesg->entries()) { my $norm_release = substr( $branch->dn, 0, length( $branch->dn ) - length( $base ) ); if( length( $norm_release ) > 0 ) { $norm_release = substr( $norm_release, 0, length( $norm_release ) - 1 ); my @rdns = gosa_ldap_split_dn( $norm_release ); $norm_release = join( ',', reverse @rdns ); $norm_release =~ s/,ou=/\//g; $norm_release =~ s/\./\//g; $norm_release = substr( $norm_release, 3 ); } } # Get all classes my $filter = '(&(|(objectClass=FAIclass)(objectClass=FAIbranch))(|'; foreach my $type (values %fai_items) { $filter .= '(objectClass=' . @{$type}[ 0 ] . ')' if( defined @{$type}[ 0 ] ); } $filter .= '))'; $mesg = $ldap->search( base => $base, filter => $self->prepare_filter( $filter ), scope => 'sub', attrs => [ 'cn', 'FAIclass', 'FAIstate' ] ); return( "LDAP search error: " . $mesg->error . ' (' . $mesg->code . ")\n" ) if( 0 != $mesg->code ); foreach my $entry ($mesg->entries()) { my $dn = substr( $entry->dn, 0, length( $entry->dn ) - length( $base ) ); $dn = substr( $dn, 0, length( $dn ) - 1 ) if( length( $dn ) > 0 ); my @rdns = gosa_ldap_split_dn( $dn ); my $class = $entry->get_value( 'cn' ); my $type = substr( $rdns[ 1 ], 3 ); my $release = join( ',', reverse splice( @rdns, 2 ) ); $release =~ s/,ou=/\//g; $release = substr( $release, 3 ); my $norm_release = $release; $norm_release =~ s/\./\//g; if( ! exists $releases{ $norm_release } ) { warn( sprintf( "Unknown release for object '%s'", $entry->dn() ) ) if( ! exists $releases{ $norm_release } ); next; } if( $type eq 'profile' ) { my $classlist = $entry->get_value( 'FAIclass' ); $releases{ $norm_release }{ $type }{ $class }{ '_classes' } = (); $releases{ $norm_release }{ $type }{ $class }{ '_state' } = $entry->get_value( 'FAIstate' ); foreach my $profile_class (split( ' ', $classlist )) { if( ":" eq substr( $profile_class, 0, 1 ) ) { warn( "Release '$profile_class' found in profile '$class' of '$release'." ); } else { push( @{$releases{ $norm_release }{ $type }{ $class }{ '_classes' }}, $profile_class ); } } } else { $releases{ $norm_release }{ $type }{ $class } = undef; } } $self->{ 'FAI_TREES' } = \%releases; } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # $self = GOsa::FAI handle # $release = Release version # $flags = @see get_class_cache # # Returns a hashref including the classes for the FAI types # $result->{ ''profile', 'hook', ... }->{ 'class' } # In case of profiles it points to a hashref of profile subclasses # sub extend_class_cache { my( $self, $release, $flags ) = @_; # Set variables from flags $flags = 1 if( ! defined $flags ); my $generate = $flags & FAI_CACHE_GENERATE ? 1 : 0; my $force = $flags & FAI_CACHE_FORCE ? 1 : 0; my( $rdns ) = $self->release_check( $release, $force ); return $rdns if( ref( $rdns ) ne 'ARRAY' ); my %cache = (); my $cache_ref; my $norm_release = $release; $norm_release =~ s/\./\./g; # Return cached values if not enforced if( ! $force ) { $cache_ref = $self->{ 'FAI_TREES' }{ $norm_release } if( exists $self->{ 'FAI_TREES' }{ $norm_release } ); return $self->{ 'FAI_TREES' }{ $norm_release } if( defined $cache_ref && defined $cache_ref->{ 'extended' } ); return undef if( ! $generate ); } $cache_ref = $self->get_class_cache( $release, $flags ) if( ! defined $cache_ref ); return $cache_ref if( 'HASH' ne ref( $cache_ref ) ); my $ldap = $self->{ 'LDAP' }; my $base = $self->{ 'base' }; my( $entry, $type, $faiclasses ); # Check all FAI OUs for classnames while( ($type, $faiclasses) = each %$cache_ref ) { # Skip, if this entry is not an FAI type next if(! exists $fai_items{ $type }); # Skip, if this type doesn't have additional information my @attrs = @{$fai_items{ $type }}; next if( 1 == scalar @attrs ); my $objclass = $attrs[ 1 ]; # Filter attributes @attrs = splice( @attrs, 2 ); push( @attrs, 'FAIstate' ) if( scalar @attrs ); foreach my $class (keys( %{$faiclasses} )) { my $mesg; # For package lists we have to store the actual data in an extra object if( 'debconf' eq $type ) { $mesg = $ldap->search( base => "cn=${class},ou=packages,@{$rdns}[0],${base}", filter => $self->prepare_filter( "(objectClass=$objclass)" ), scope => 'one' ); } elsif( 'packages' eq $type ) { $mesg = $ldap->search( base => "cn=${class},ou=${type},@{$rdns}[0],${base}", filter => $self->prepare_filter( "(objectClass=$objclass)" ), scope => 'base' ); return( "LDAP search error: " . $mesg->error . ' (' . $mesg->code . ")\n" ) if( 0 != $mesg->code ); # Store entries $cache_ref->{ ${type} }->{ ${class} } = ($mesg->entries())[0]; next; } elsif( 'disk' eq $type ) { # print( "Disk config lookup for '${class}'...\n" ); my $setup_storage = 0; my $class_base = "cn=${class},ou=${type},@{$rdns}[0],${base}"; $mesg = $ldap->search( base => ${class_base}, filter => $self->prepare_filter( '(|(objectClass=FAIpartitionDisk)(objectClass=FAIpartitionEntry)(objectClass=FAIpartitionTable))' ), scope => 'sub' ); return( "LDAP search error: " . $mesg->error . ' (' . $mesg->code . ")\n" ) if( 0 != $mesg->code ); # Decode disks and partition tables my @entries = $mesg->entries(); my %disk_configs; my $checked_entries = scalar @entries; while( scalar @entries ) { $entry = shift( @entries ); my @objclasses = $entry->get_value( 'objectClass' ); my $valid_object = 0; foreach my $obj (@objclasses) { my $dn_tail; my @rdns; # Check partition if( $obj =~ /^FAIpartitionTable$/i ) { if (defined $entry->get_value( 'FAIpartitionMethod' )){ $setup_storage = $entry->get_value( 'FAIpartitionMethod' ) eq 'setup-storage'; } $entry = undef; last; } # Check disk if( $obj =~ /^FAIpartitionDisk$/i ) { @rdns = gosa_ldap_split_dn( $entry->dn() ); shift( @rdns ); $dn_tail = join( ',', @rdns ); my $cn = $entry->get_value( 'cn' ); last if( $dn_tail !~ /^${class_base}$/ || (exists $disk_configs{${cn}}) ); if( ! is_removed( $entry ) ) { my %partitions = (); $disk_configs{${cn}} = \%partitions; $disk_configs{${cn}}->{'disk'} = $entry; $disk_configs{${cn}}->{'setup-storage'} = $setup_storage; # print( " + disk '${cn}'\n" ); } else { $disk_configs{${cn}} = undef; } $entry = undef; $valid_object = 1; last; } # Check partition if( $obj =~ /^FAIpartitionEntry$/i ) { my @rdns = gosa_ldap_split_dn( $entry->dn() ); shift @rdns; my $disk = shift @rdns; $dn_tail = join( ',', @rdns ); ($disk) = $disk =~ /^[^=]+=(.*)/; last if( $dn_tail !~ /^${class_base}$/ ); # Since the LDAP result is unordered, there might be a # valid disk later - mark partition as valid $valid_object = 1; last if( ! defined $disk_configs{${disk}} ); $disk_configs{${disk}}-> { $entry->get_value( 'FAIpartitionNr' ) } = $entry; # print( " + partition '" . $entry->get_value( 'FAIpartitionNr' ) # . "' to disk '${disk}'\n" ); $entry = undef; last; } } $checked_entries--; if( defined $entry ) { # If we didn't store the entry yet, check if it's valid if( $checked_entries < 0 ) { print( "Unable to find disk for partition '" . $entry->get_value( 'cn' ) . "' - skipped\n" ); next; } if( ! $valid_object ) { print( "Invalid disk config entry '" . $entry->dn() . "' - skipped\n" ); next; } push( @entries, $entry ) if( defined $entry ); } } # Store disk config $cache_ref->{ ${type} }->{ ${class} } = \%disk_configs; next; } else { my %search = ( base => "cn=${class},ou=${type},@{$rdns}[0],${base}", filter => $self->prepare_filter( "(objectClass=$objclass)" ), scope => 'one' ); $search{ 'attrs' } = @attrs if( scalar @attrs ); $mesg = $ldap->search( %search ); } return( sprintf( "LDAP search error at line %i: %s (%i)\n", __LINE__, $mesg->error, $mesg->code ) ) if( 0 != $mesg->code ); # Store entries if( 0 != $mesg->count ) { my %values; foreach my $entry ($mesg->entries()) { my $key; if( 'debconf' eq ${type} ) { $key = $entry->get_value( 'FAIvariable' ); } elsif( 'templates' eq ${type} ) { $key = $entry->get_value( 'FAItemplatePath' ); } else { $key = $entry->get_value( 'cn' ); } if( exists $values{ $key } ) { warn( "Duplicated key '$key' in '$class' for type '$type'" ); } else { $values{ $key } = $entry; } } $cache_ref->{ ${type} }->{ ${class} } = \%values; } else { delete( $cache_ref->{ ${type} }->{ ${class} } ); } } } $cache_ref->{ 'extended' } = 1; $self->{ 'FAI_TREES' }{ $norm_release } = $cache_ref; return $self->{ 'FAI_TREES' }{ $norm_release }; } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Verify, if the FAI object has the 'removed' state # # $entry = Net::LDAP::Entry # # Returns true, if the 'FAIstate' contains a removed # sub is_removed { my $entry = shift; my $state = $entry->get_value( 'FAIstate' ); my %states = map { $_ => 1 } split( "\\|", $state ) if( defined $state ); return 1 if( exists $states{ 'removed' } ); return 0; } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Common init code for all dump_ functions # # $self = GOsa::FAI handle # $release = Release to dump # $classref = # $flags = # $type = # $nomerge = # # $classref = Arrayref to the requested FAIclass list (already expanded) # $dumpdir = # $cow_merge = # $cow_releases = # sub init_dump_function { my( $self, $release, $classref, $flags, $type ) = @_; my( $release_rdns, $cow_releases ) = $self->release_check( $release ); return $release_rdns if( 'ARRAY' ne ref( $release_rdns ) ); my $dumpdir = $self->{ 'dumpdir' }; # Fill $classref with all classes, if not supplied if( ! defined $classref ) { my %seen; if( $self->{ 'flags' } & FAI_FLAG_NO_COW ) { my @cows = ( $release ); $cow_releases = \@cows; } foreach my $cur_release (@$cow_releases) { my $typeref = $self->extend_class_cache( $cur_release, $flags )->{ $type }; foreach my $item (keys %$typeref) { $seen{ $item } = 1; } } my @classlist = keys( %seen ); $classref = \@classlist; } # Merge release hashes into COW hash my %cow_merge; foreach my $class (@$classref) { foreach my $cur_release (reverse @$cow_releases) { my $typeref = $self->extend_class_cache( $cur_release, $flags )->{ $type }; next if( ! exists $typeref->{ $class } ); if( ref( $typeref->{ $class } ) eq 'HASH' ) { while( my($key, $value) = each %{$typeref->{ $class }} ) { $cow_merge{ $class }{ $key } = $value; } } else { $cow_merge{ $class } = $typeref->{ $class }; } } } return( $classref, $dumpdir, \%cow_merge, $cow_releases ); } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Dumps variables from class cache # # $self = GOsa::FAI handle # $release = Release string # $classref = Arrayref to the requested FAIclass list (already expanded) # $flags = @see get_class_cache, but defaults to 0; # # Returns undef, if no error occured, otherwise the error message # sub dump_variables { my( $self, $release, $classref, $flags ) = @_; my( $dumpdir, $cow_cacheref ); ( $classref, $dumpdir, $cow_cacheref ) = $self->init_dump_function( $release, $classref, $flags, 'variables' ); return $classref if( ! defined $dumpdir ); foreach my $class (@$classref) { next if( ! exists $cow_cacheref->{ $class } ); my %vars = (); foreach my $entry (values %{$cow_cacheref->{ $class }}) { next if( is_removed( $entry ) ); my $cn = $entry->get_value( 'cn' ); $vars{ $cn } = $entry->get_value( 'FAIvariableContent' ); } next if( 0 == scalar keys( %vars ) ); if( $self->{ 'flags' } & FAI_FLAG_VERBOSE ) { print( "Generate variable file for class '${class}'.\n" ); print( " Vars: " . join( ", ", keys %vars ) . "\n" ); } next if( $self->{ 'flags' } & FAI_FLAG_DRY_RUN ); if( ! -d "$dumpdir/class" ) { eval { mkpath( "$dumpdir/class" ); }; return( "Can't create dir '$dumpdir/class': $!\n" ) if( $@ ); } open (FAIVAR,">$dumpdir/class/${class}.var") || return( "Can't create '$dumpdir/class/${class}.var': $!\n" ); while( my( $key, $value ) = each( %vars ) ) { print( FAIVAR "${key}='${value}'\n" ); } close (FAIVAR); } return undef; } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Dumps package lists from class cache # # $self = GOsa::FAI handle # $release = Release string # $classref = Arrayref to the requested FAIclass list (already expanded) # $flags = @see get_class_cache, but defaults to 0; # # Returns undef, if no error occured, otherwise the error message # sub dump_package_list { my( $self, $release, $classref, $flags ) = @_; my( $dumpdir, $cow_cacheref ); ( $classref, $dumpdir, $cow_cacheref ) = $self->init_dump_function( $release, $classref, $flags, 'packages' ); return $classref if( ! defined $dumpdir ); my( $class, $entry, $method ); if( ! -d "$dumpdir/package_config" ) { eval { mkpath( "$dumpdir/package_config" ); }; return( "Can't create dir '$dumpdir/package_config': $!\n" ) if( $@ ); } my %uniq_sections = (); foreach $class (@$classref) { next if( ! exists $cow_cacheref->{ $class } ); $entry = $cow_cacheref->{ $class }; $method = $entry->get_value( 'FAIinstallMethod' ); print( "Generate package list for class '${class}'.\n" ) if( $self->{ 'flags' } & FAI_FLAG_VERBOSE ); foreach my $section ( $entry->get_value( 'FAIdebianSection' ) ) { $uniq_sections{ $section } = undef; } next if( $self->{ 'flags' } & FAI_FLAG_DRY_RUN ); open( PACKAGES, ">$dumpdir/package_config/$class" ) || do_exit( 4, "Can't create $dumpdir/package_config/$class. $!\n" ); print PACKAGES "PACKAGES $method\n"; print PACKAGES join( "\n", $entry->get_value('FAIpackage') ); print PACKAGES "\n"; close( PACKAGES ); } my @sections = keys( %uniq_sections ); return( undef, \@sections ); } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Dumps debconf information from class cache # # $self = GOsa::FAI handle # $release = Release string # $classref = Arrayref to the requested FAIclass list (already expanded) # $flags = @see get_class_cache, but defaults to 0; # # Returns undef, if no error occured, otherwise the error message # sub dump_debconf_info { my( $self, $release, $classref, $flags ) = @_; my( $dumpdir, $cow_cacheref ); ( $classref, $dumpdir, $cow_cacheref ) = $self->init_dump_function( $release, $classref, $flags, 'debconf' ); return $classref if( ! defined $dumpdir ); my( $entry ); if( ! -d "$dumpdir/debconf" ) { eval { mkpath( "$dumpdir/debconf" ); }; return( "Can't create dir '$dumpdir/debconf': $!\n" ) if( $@ ); } foreach my $class (@$classref) { next if( ! exists $cow_cacheref->{ $class } ); my @lines = (); foreach $entry (values %{$cow_cacheref->{ $class }}) { next if( is_removed( $entry ) ); push( @lines, sprintf( "%s %s %s %s", $entry->get_value('FAIpackage'), $entry->get_value('FAIvariable'), $entry->get_value('FAIvariableType'), $entry->get_value('FAIvariableContent') ) ); } next if( 0 == scalar @lines ); open( DEBCONF, ">$dumpdir/debconf/$class" ) || return( "Can't create $dumpdir/debconf/$class. $!\n" ); print DEBCONF join( "\n", sort {$a cmp $b} @lines ); print DEBCONF "\n"; close( DEBCONF ); } return undef; } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Dumps disk configurations from class cache # # $self = GOsa::FAI handle # $release = Release string # $classref = Arrayref to the requested FAIclass list (already expanded) # $flags = @see get_class_cache, but defaults to 0; # # Returns undef, if no error occured, otherwise the error message # sub dump_disk_config { my( $self, $release, $classref, $flags ) = @_; my( $cow_cacheref, $dumpdir ); ( $classref, $dumpdir, $cow_cacheref ) = $self->init_dump_function( $release, $classref, $flags, 'disk' ); return $classref if( ! defined $dumpdir ); if( ! -d "$dumpdir/disk_config" ) { eval { mkpath( "$dumpdir/disk_config" ); }; return( "Can't create dir '$dumpdir/disk_config': $!\n" ) if( $@ ); } my $first_lvm_disk= 1; my $disk_index= 0; my $setup_storage= 0; foreach my $class (@$classref) { next if( ! exists $cow_cacheref->{ $class } ); my $disk_config = $cow_cacheref->{ $class }; my( %all_disks, $disk, $entry ); foreach my $type ("disk", "raid", "lvm") { foreach $disk (keys %{$disk_config}) { next if( ! defined $disk_config->{ $disk } ); # Extract setup storage mode my $dc = $disk_config->{ $disk }->{ 'disk' }; $setup_storage= $disk_config->{ $disk }->{ 'setup-storage' }; # Extract disk information my $disk_type = "disk"; my $disk_options = ""; my $lvm_name= ""; if (defined $dc->get_value('FAIdiskOption')) { foreach ($dc->get_value('FAIdiskOption')) { $disk_options= $disk_options . " " . $_; } } if (defined $dc->get_value('FAIdiskType')) { $disk_type = $dc->get_value('FAIdiskType'); } # Skip workaround to manage order of disk types next if( $disk_type ne $type); # Update index my $disk_label= $disk_index."-".$disk; $all_disks{ $disk_label } = {}; # In case of LVM, we need a special handling, because the volumes # get handled as disks internally if ($disk_type eq "lvm") { $lvm_name = $dc->get_value('cn'); my $size = ""; foreach ($dc->get_value('FAIlvmDevice')) { $size= $size . "," . $_; } $size=~ s/^.//; if ($first_lvm_disk) { $first_lvm_disk= 0; $all_disks{ $disk_label }{ 0 } = "disk_config lvm$disk_options\nvg $lvm_name $size\n"; } else { $all_disks{ $disk_label }{ 0 } = "vg $lvm_name $size\n"; } } else { $all_disks{ $disk_label }{ 0 } = "disk_config $disk$disk_options\n"; } # Remove disk information from hash delete $disk_config->{ $disk }->{ 'disk' }; delete $disk_config->{ $disk }->{ 'setup-storage' }; my $logic_count = 4; my $primary_count = 0; foreach my $partition_nr (sort {$a <=> $b} (keys %{$disk_config->{ $disk }}) ) { my $line; my $dl = $disk_config->{ $disk }->{ $partition_nr }; if ($dl->get_value('FAIpartitionType') eq 'primary'){ $primary_count++; } else { $logic_count++; } my $part_flags = $dl->get_value('FAIpartitionFlags'); my $mount_opts = $dl->get_value('FAImountOptions'); $mount_opts = 'rw' if( ! defined $mount_opts || ($mount_opts eq '') ); my $combined_opts= ""; my $c_opts = $dl->get_value('FAIfsCreateOptions'); my $t_opts = $dl->get_value('FAIfsTuneOptions'); if (defined $c_opts) { $combined_opts= "createopts=\"$c_opts\" "; } if (defined $t_opts) { $combined_opts.= "tuneopts=\"$t_opts\""; } if ($setup_storage) { if ($disk_type eq 'lvm') { $line= sprintf( "%-20s %-18s %-12s %-10s %s %s\n", $lvm_name."-".$dl->get_value('cn'), $dl->get_value('FAImountPoint'), $dl->get_value('FAIpartitionSize'), $dl->get_value('FAIfsType'), $mount_opts, $combined_opts); } else { $line= sprintf( "%-20s %-18s %-12s %-10s %s %s\n", $dl->get_value('FAIpartitionType'), $dl->get_value('FAImountPoint'), $dl->get_value('FAIpartitionSize'), $dl->get_value('FAIfsType'), $mount_opts, $combined_opts); } } else { if (defined $part_flags && ($part_flags eq 'preserve') ){ my $part_type; if ($dl->get_value('FAIpartitionType') eq 'primary'){ $part_type = 'preserve' . $primary_count; } else { $part_type = 'preserve' . $logic_count; } $line = sprintf( "%-7s %-12s %-12s %-10s ; %s mounttype=uuid\n", $dl->get_value('FAIpartitionType'), $dl->get_value('FAImountPoint'), $part_type, $mount_opts, $dl->get_value('FAIfsOptions') ); } elsif ($dl->get_value('FAIfsType') eq 'swap') { # Labels are limited to 15 chars my $swaplabel = 'swap-' . gosa_gen_random_str( 10 ); $line = sprintf( "%-7s %-12s %-12s %-10s ; mounttype=label label='%s'\n", $dl->get_value('FAIpartitionType'), $dl->get_value('FAImountPoint'), $dl->get_value('FAIpartitionSize'), $mount_opts, $swaplabel ); } else { $line= sprintf( "%-7s %-12s %-12s %-10s ; %s %s mounttype=uuid\n", $dl->get_value('FAIpartitionType'), $dl->get_value('FAImountPoint'), $dl->get_value('FAIpartitionSize'), $mount_opts, $dl->get_value('FAIfsOptions'), $dl->get_value('FAIfsType') ); } } $all_disks{ $disk_label }{ $partition_nr } = $line; } $disk_config->{ $disk }->{ 'disk' }= $dc; $disk_config->{ $disk }->{ 'setup-storage' }= $setup_storage; } $disk_index++; } my @disk_config_lines; if( %all_disks ) { foreach my $disk (sort {$a cmp $b} keys %all_disks) { foreach my $part (sort {$a <=> $b} keys %{$all_disks{ $disk }} ) { push( @disk_config_lines, $all_disks{ $disk }{ $part } ); } } } open( DISK_CONFIG, ">$dumpdir/disk_config/${class}" ) || return( "Can't create $dumpdir/disk_config/$class. $!\n" ); print DISK_CONFIG join( '', @disk_config_lines ); close( DISK_CONFIG ); # Enable setup storage if needed if ($setup_storage && ! ($self->{ 'flags' } & FAI_FLAG_DRY_RUN)) { if( ! -d "$dumpdir/class" ) { eval { mkpath( "$dumpdir/class" ); }; return( "Can't create dir '$dumpdir/class': $!\n" ) if( $@ ); } open (FAIVAR,">>$dumpdir/class/${class}.var") || return( "Can't create/append '$dumpdir/class/${class}.var': $!\n" ); print( FAIVAR "USE_SETUP_STORAGE=1\n" ); close (FAIVAR); } } return undef; } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Writes the file in 'FAI mode' and adds mode info # # $filename = full path to real file # $data = file data # $mode = file mode # $owner = file owner # $class = FAIclass, the file belongs to # # Returns nothing # sub write_fai_file { my( $filename, $data, $mode, $owner, $class ) = @_; my $fclass = ''; return if( scalar @_ < 2 ); # Append class to filename $fclass = '/' . $class if( defined $class ); open( FILE,">${filename}${fclass}" ) || return( "Can't create file '${filename}${fclass}': $!\n" ); print( FILE $data ) if( defined $data ); close( FILE ); if( defined $class && ('' ne $class) ) { # ($owner,$group,$mode,$class) = split my (@modelines) = (); if( -f "${filename}/file-modes" ) { open( MODES, '<', "${filename}/file-modes" ) || return( "Couldn't open modefile '${filename}/file-modes': $!\n" ); (@modelines) = ; close( MODES ); } open( MODES, '>', "${filename}/file-modes" ) || return( "Couldn't open modefile '${filename}/file-modes': $!\n" ); # Remove old mode entry from file-modes foreach my $line ( @modelines ) { chomp( $line ); print( MODES "$line\n" ) if( ! ($line =~ /${class}$/) ); } # Fix empty mode $mode = '0640' if( ! defined $mode || ($mode !~ /^0*[0-7]{1,4}$/) ); # Fix empty owners if( defined $owner && ('' ne $owner) ) { $owner =~ tr/\.:/ /; } else { $owner = 'root root'; } print( MODES "$owner $mode $class\n" ); close( MODES ); } else { chmod( oct($mode), ${filename} ) if( defined $mode && ($mode =~ /^0*[0-7]{1,4}$/) ); gosa_file_chown( ${filename}, $owner ) if( defined $owner && ($owner ne '') ); } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Dumps scripts from class cache # # $self = GOsa::FAI handle # $release = Release string # $classref = Arrayref to the requested FAIclass list (already expanded) # $flags = @see get_class_cache, but defaults to 0; # # Returns undef, if no error occured, otherwise the error message # sub dump_scripts { my( $self, $release, $classref, $flags ) = @_; my( $cow_cacheref, $dumpdir ); ( $classref, $dumpdir, $cow_cacheref ) = $self->init_dump_function( $release, $classref, $flags, 'scripts' ); return $classref if( ! defined $dumpdir ); foreach my $class (@$classref) { next if( ! exists $cow_cacheref->{ $class } ); if( ! -d "$dumpdir/scripts/${class}" ) { eval { mkpath( "$dumpdir/scripts/${class}" ); }; return( "Can't create dir '$dumpdir/scripts/${class}': $!\n" ) if( $@ ); } my @lines = (); foreach my $entry (values %{$cow_cacheref->{ $class }}) { my $name = $entry->get_value( 'cn' ); my $prio = $entry->get_value( 'FAIpriority' ); my $script_name = sprintf( '%02d-%s', $prio, $name ); my $script_path = "${dumpdir}/scripts/${class}/${script_name}"; if( is_removed( $entry ) ) { unlink( "${script_path}" ) if( -f "${script_path}" ); next; } print( "Generate script '${script_name}' for class '${class}'.\n" ) if( $self->{ 'flags' } & FAI_FLAG_VERBOSE ); write_fai_file( "${script_path}", $entry->get_value( 'FAIscript' ), '0700' ) if( ! ($self->{ 'flags' } & FAI_FLAG_DRY_RUN) ); } } return undef; } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Dumps templates from LDAP # # $self = GOsa::FAI handle # $release = Release string # $classref = Arrayref to the requested FAIclass list (already expanded) # $flags = @see get_class_cache, but defaults to 0; # # Returns undef, if no error occured, otherwise the error message # sub dump_templates { my( $self, $release, $classref, $flags ) = @_; my( $cow_cacheref, $dumpdir ); ( $classref, $dumpdir, $cow_cacheref ) = $self->init_dump_function( $release, $classref, $flags, 'templates' ); return $classref if( ! defined $dumpdir ); my( $release_base ) = $self->release_check( $release ); my $ldap = $self->{ 'LDAP' }; my $base = $self->{ 'base' }; if( ! -d "$dumpdir/files" ) { eval { mkpath( "$dumpdir/files" ); }; return( "Can't create dir '$dumpdir/files': $!\n" ) if( $@ ); } foreach my $class (@$classref) { next if( ! exists $cow_cacheref->{ $class } ); foreach my $entry (values %{$cow_cacheref->{ $class }}) { my $template_path = $entry->get_value( 'FAItemplatePath' ); chomp( $template_path ); my $target_path = "${dumpdir}/files/${template_path}/${class}"; # Remove removed files ;-) if( is_removed( $entry ) ) { unlink( "${target_path}" ) if( -f "${target_path}" ); next; } if( ! -d "$dumpdir/files/$template_path" ) { eval { mkpath( "$dumpdir/files/$template_path" ); }; return( "Can't create dir '$dumpdir/files/$template_path': $!\n" ) if( $@ ); } print( "Generate template '${template_path}' for class '${class}'.\n" ) if( $self->{ 'flags' } & FAI_FLAG_VERBOSE ); write_fai_file( "${dumpdir}/files/${template_path}", $entry->get_value('FAItemplateFile'), $entry->get_value('FAImode'), $entry->get_value('FAIowner'), $class ) if( ! ($self->{ 'flags' } & FAI_FLAG_DRY_RUN) ); } } return undef; } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # $self = GOsa::FAI handle # $release = Release version # $classref = Arrayref of classes to dump (will be expanded) # # Returns undef, if no error occured, otherwise the error message # sub dump_hooks { my( $self, $release, $classref, $flags ) = @_; my( $dumpdir, $cow_cacheref ); ( $classref, $dumpdir, $cow_cacheref ) = $self->init_dump_function( $release, $classref, $flags, 'hooks' ); return $classref if( ! defined $dumpdir ); foreach my $class (@$classref) { next if( ! exists $cow_cacheref->{ $class } ); if( ! -d "$dumpdir/hooks" ) { eval { mkpath( "$dumpdir/hooks" ); }; return( "Can't create dir '$dumpdir/hooks': $!\n" ) if( $@ ); } my @lines = (); foreach my $entry (values %{$cow_cacheref->{ $class }}) { my $task = $entry->get_value( 'FAItask' ); my $hook_path = "${dumpdir}/hooks/${task}.${class}"; my $cn = $entry->get_value( 'cn' ); if( is_removed( $entry ) ) { unlink( "${hook_path}" ) if( -f "${hook_path}" ); next; } print( "Generate hook '$cn' ($task) for class '${class}'.\n" ) if( $self->{ 'flags' } & FAI_FLAG_VERBOSE ); write_fai_file( ${hook_path}, $entry->get_value( 'FAIscript' ), '0700' ) if( ! ($self->{ 'flags' } & FAI_FLAG_DRY_RUN) ); } } return undef; } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # $self = GOsa::FAI handle # $release = Release version # $classref = Arrayref of classes to dump (will be expanded) # $hostname = Host to use in classlist expansion # # Returns a hashref including the classes for the FAI types # $result->{ ''profile', 'hook', ... }->{ 'class' } # In case of profiles it points to a hashref of profile subclasses # sub dump_release { my( $self, $release, $classref, $hostname ) = @_; my $cls_release; if( defined $classref ) { ($classref, $cls_release) = $self->resolve_classlist( $classref, $release, $hostname ); return( undef, $classref ) if( 'ARRAY' ne ref( $classref ) ); $release = $cls_release if( ! defined $release ); } return( undef, "No release specified\n" ) if( ! defined $release ); my $cacheref = $self->extend_class_cache( $release ); return( undef, $cacheref ) if( 'HASH' ne ref( $cacheref ) ); return( undef, "No dump directory specified" ) if( ! defined $self->{ 'dumpdir' } ); my $dumpdir = $self->{ 'dumpdir' }; $dumpdir .= '/class' if( defined $hostname ); # Create dump directory and hosts classfile if( ! -d "${dumpdir}" ) { eval { mkpath( "${dumpdir}" ); }; return( undef, "Can't create dir '${dumpdir}': $!\n" ) if( $@ ); } if( defined ${hostname} ) { open( CLASSLIST, ">${dumpdir}/${hostname}" ) || return( undef, "Can't create ${dumpdir}/${hostname}. $!\n" ); print( CLASSLIST join( ' ', @${classref} ) ); close( CLASSLIST ); } # Add FAI standard classes for dump $classref = $self->expand_fai_classlist( $classref, $hostname ) if( defined $classref ); # Dump variables, packages, debconf, scripts, templates and disk_config my $dump_result = $self->dump_variables( $release, $classref ); return( undef, $dump_result ) if( defined $dump_result ); my $sections; ($dump_result, $sections) = $self->dump_package_list( $release, $classref ); return( undef, $dump_result ) if( defined $dump_result ); $dump_result = $self->dump_debconf_info( $release, $classref ); return( undef, $dump_result ) if( defined $dump_result ); $dump_result = $self->dump_scripts( $release, $classref ); return( undef, $dump_result ) if( defined $dump_result ); $dump_result = $self->dump_templates( $release, $classref ); return( undef, $dump_result ) if( defined $dump_result ); $dump_result = $self->dump_disk_config( $release, $classref ); return( undef, $dump_result ) if( defined $dump_result ); $dump_result = $self->dump_hooks( $release, $classref ); return( undef, $dump_result ) if( defined $dump_result ); return( $sections ); } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # $self = GOsa::FAI handle # $class_str = A space seperated string of classes or arrayref # $release = Overwrite or set release provided by $class_str # $hostname = Host to use in classlist expansion # $force = Ignore cached values and rebuild # sub resolve_classlist { my( $self, $class_str, $release, $hostname, $force ) = @_; my( @classes, @newclasses, $cls_release, $class ); # Set @classes depending on parameter type if( 'ARRAY' eq ref( $class_str ) ) { @classes = @{$class_str}; } else { @classes = split( ' ', $class_str ); } # Check for release in classlist foreach my $class (@classes) { if( ":" eq substr( $class, 0, 1 ) ) { return( "Duplicated release in classlist\n" ) if( defined $cls_release ); if( 2 < length( ${class} ) ) { $cls_release = substr( $class, 1 ); } else { return( "Invalid release ':' in classlist\n" ); } } else { push @newclasses, $class; } } # Overwrite release if supplied $cls_release = $release if( defined $release ); return( "No release for lookup defined\n" ) if( ! defined $cls_release ); # Always prepend release @classes = @newclasses; $class_str = ':' . $cls_release . join( ' ', @classes ); # Return cached values if not enforced if( ! defined $force && $force ) { return $self->{ 'RESOLVED' }{ $class_str } if( exists $self->{ 'RESOLVED' }{ $class_str } ); } my $ldap = $self->{ 'LDAP' }; my $base = $self->{ 'base' }; my( $release_rdns, $cow_releases ) = $self->release_check( $cls_release ); @newclasses = (); my %seen = ( 'LAST' => 1, 'DEFAULT' => 1 ); $seen{ $hostname } = 1 if( defined $hostname ); my @faiprofiles = (); my( $entry, $mesg ); # We need to walk through the list of classes and watch out for # a profile, which is named like the class. Replace the profile # name by the names of the included classes. while( 0 != scalar @classes ) { $class = shift( @classes ); # Skip duplicated profiles and classes next if( exists $seen{ $class } ); foreach my $cow_release (@$cow_releases) { my $cache = $self->get_class_cache( $cow_release ); next if( ! exists $cache->{ 'profiles' } ); next if( ! exists $cache->{ 'profiles' }->{ $class } ); my @profile_classes = @{$cache->{ 'profiles' }->{ $class }{ '_classes' }}; foreach my $profile_class (reverse @profile_classes) { # Check if the class is already in the list? next if( exists $seen{ $profile_class } ); # Prepend class - it may also be a profile unshift( @classes, $profile_class ) if( ! exists $seen{ $profile_class } ); } $seen{ $class } = 1; last; } # Just push non-profile classes if( ! exists $seen{ $class } ) { push( @newclasses, $class ); $seen{ $class } = 1; } } return( \@newclasses, $cls_release ); } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # $self = GOsa::FAI handle # $class_str = A space seperated string of classes or arrayref # $hostname = The non-FQDN hostname # # Little convenience function to add standard FAI classes, which are added # automatically by FAI. These are needed for a correct dump. # sub expand_fai_classlist { my( $self, $classref, $hostname ) = @_; my( @newclasses ); return undef if( ! defined $classref ); if( 'ARRAY' eq ref( $classref ) ) { @newclasses = @$classref; } else { @newclasses = split( $classref ); } # These classes are added automatically by FAI... unshift( @newclasses, "DEFAULT" ); push( @newclasses, "${hostname}" ) if( defined $hostname ); push( @newclasses, "LAST" ); return \@newclasses if( 'ARRAY' eq ref( $classref ) ); return join( ' ', @newclasses ); } END {} 1; __END__ # vim:ts=2:sw=2:expandtab:shiftwidth=2:syntax:paste gosa-perl/GOsa/Common.pm0000644000175000017500000004420711326407245014723 0ustar benoitbenoit# Copyright (c) 2008 Landeshauptstadt München # # Author: Jan-Marek Glogowski # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . package GOsa::Common; require 5.6.0; use strict; use warnings; use Net::LDAP; use Net::LDAP::Constant qw(LDAP_NO_SUCH_OBJECT LDAP_REFERRAL); use File::Basename; use POSIX; use Cwd qw(abs_path); use URI; BEGIN { use Exporter (); our $VERSION = '2008-02-26_01'; our @ISA = qw(Exporter); our %EXPORT_TAGS = ( 'ldap' => [qw( &gosa_ldap_parse_config &gosa_ldap_fsearch &gosa_ldap_rsearch &gosa_ldap_is_single_result &gosa_ldap_split_dn &gosa_ldap_init )], 'misc' => [qw( &gosa_file_write &gosa_file_chown &gosa_array_find_and_remove &gosa_options_parse &gosa_gen_random_str &gosa_get_pid_lock &gosa_load_modules )] ); Exporter::export_ok_tags(keys %EXPORT_TAGS); } #------------------------------------------------------------------------------ sub gosa_ldap_parse_config { my ($ldap_config) = @_; # Indicat, if it's a user or global config my $is_user_cfg = 1; # If we don't get a config, go searching for it if( ! defined $ldap_config ) { # Check the local and users LDAP config name my $ldaprc = ( exists $ENV{ 'LDAPRC' } ) ? basename( $ENV{ 'LDAPRC' } ) : 'ldaprc'; # First check current directory $ldap_config = $ENV{ 'PWD' } . '/' . $ldaprc; goto config_open if( -e $ldap_config ); # Second - visible in users home $ldap_config = $ENV{ 'HOME' } . '/' . $ldaprc; goto config_open if( -e $ldap_config ); # Third - hidden in users home $ldap_config = $ENV{ 'HOME' } . '/.' . $ldaprc; goto config_open if( -e $ldap_config ); # We don't allow BINDDN in global config $is_user_cfg = 0; # Global environment config if( exists $ENV{ 'LDAPCONF' } ) { $ldap_config = $ENV{ 'LDAPCONF' }; goto config_open if( -e $ldap_config ); } # Last chance - global config $ldap_config = '/etc/ldap/ldap.conf' } config_open: # Read LDAP file if it's < 100kB return if( (-s "${ldap_config}" > 100 * 1024) || (! open( LDAPCONF, "<${ldap_config}" )) ); my @content = ; close( LDAPCONF ); my( $ldap_base, @ldap_uris, $ldap_bind_dn ); # Parse LDAP config foreach my $line (@content) { $line =~ /^\s*(#|$)/ && next; chomp($line); if ($line =~ /^BASE\s+(.*)$/i) { $ldap_base= $1; } elsif( $line =~ /^BINDDN\s+(.*)$/i ) { $ldap_bind_dn = $1 if( $is_user_cfg ); } elsif ($line =~ m#^URI\s+(.*)\s*$#i ) { my (@ldap_servers) = split( ' ', $1 ); foreach my $server (@ldap_servers) { push( @ldap_uris, $1 ) if( $server =~ m#^(ldaps?://([^/:\s]+)(:([0-9]+))?)/?$#i ); } } } return( $ldap_base, \@ldap_uris, $ldap_bind_dn, $ldap_config ); } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Common LDAP initialization routine # # $ldap_conf = LDAP config file - may be undef # $prompt_dn = Prompt user for bind dn if true # $bind_dn = Use DN to bind to LDAP server # $prompt_pwd = Prompt user for bind password if true # $bind_pwd = Use password to bind to LDAP server # $obfuscate_pwd = Show stars instead omiting echo # # Returns a hash of results # 'BASE' => LDAP search base from config # 'URIS' => LDAP server URIs from config # 'HANDLE' => Net::LDAP handle # 'BINDDN' => Bind DN from config or prompt # 'BINDPWD' => Bind password from prompt # 'CFGFILE' => Config file used # # These values are just filled, if they weren't provided, # i.e. # sub gosa_ldap_init { my( $ldap_conf, $prompt_dn, $bind_dn, $prompt_pwd, $bind_pwd, $obfuscate_pwd ) = @_; my %results; # Parse ldap config my ($base,$ldapuris,$binddn,$file) = gosa_ldap_parse_config( $ldap_conf ); %results = ( 'BASE' => $base, 'URIS' => $ldapuris, 'BINDDN' => $binddn ); $results{ 'CFGFILE' } = $file if( $file ne $ldap_conf ); return( "Couldn't find LDAP base in config!" ) if( ! defined $base ); return( "Couldn't find LDAP URI in config!" ) if( ! defined $ldapuris ); # Create handle my $ldap = Net::LDAP->new( $ldapuris ) || return( sprintf( "LDAP 'new' error: %s (%i)", $@, __LINE__ ) ); $results{ 'HANDLE' } = $ldap; # Prompt for DN if( (! defined $bind_dn) && (defined $prompt_dn && $prompt_dn) ) { $| = 1; print( 'Bind DN: ' ); $| = 0; $bind_dn = ; $results{ 'BINDDN' } = $bind_dn; } my $mesg; if( defined $bind_dn ) { if( defined $bind_pwd ) { $mesg = $ldap->bind( $binddn, password => $bind_pwd ); } elsif( defined $prompt_pwd ) { # Prompt for password $| = 1; print( 'Password: ' ); $| = 0; $bind_pwd = ''; # Disable terminal echo system "stty -echo -icanon"; my $inchr; while (sysread STDIN, $inchr, 1) { if (ord($inchr) < 32) { last; } $bind_pwd .= $inchr; syswrite( STDOUT, "*", 1 ) # print asterisk instead if( defined $obfuscate_pwd && $obfuscate_pwd ); } system "stty echo icanon"; $results{ 'BINDPWD' } = $bind_pwd; $mesg = $ldap->bind( $binddn, password => $bind_pwd ); } else { $mesg = $ldap->bind( $binddn ); } } else { $mesg = $ldap->bind(); } # Anonymous bind return( "LDAP bind error: " . $mesg->error . ' (' . $mesg->code . ")\n" ) if( 0 != $mesg->code ); return \%results; } # # Split the dn (works with escaped commas) # # $dn = The DN to split # # Return an array of RDNs # sub gosa_ldap_split_dn { my ($dn) = @_; # Split at comma my @comma_rdns = split( ',', $dn ); my @result_rdns = (); my $line = ''; foreach my $rdn (@comma_rdns) { # Append rdn to line if( '' eq $line ) { $line = $rdn; } else { $line .= ',' . $rdn; } # Count the backslashes at the end. If we have even length # of $bs add to result array and set empty line my($bs) = $rdn =~ m/([\\]+)$/; $bs = "" if( ! defined $bs ); if( 0 == (length($bs) % 2) ) { push( @result_rdns, $line ); $line = ""; } } return( @result_rdns ); } #------------------------------------------------------------------------------ sub gosa_file_write { my @opts = @_; my $len = scalar @_; ($len < 2) && return; my $filename = shift; my $data = shift; open (SCRIPT,">${filename}") || warn "Can't create ${filename}. $!\n"; print SCRIPT $data; close(SCRIPT); ($opts[2] ne "") && chmod oct($opts[2]),${filename}; ($opts[3] ne "") && gosa_file_chown(${filename}, $opts[3]); } #------------------------------------------------------------------------------ sub gosa_file_chown { my @owner = split('.',$_[1]); my $filename = $_[0]; my ($uid,$gid); $uid = getpwnam($owner[0]); $gid = getgrnam($owner[1]); chown $uid, $gid, $filename; } # # Common checks for forward and reverse searches # sub gosa_ldap_search_checks { my( $base, $sbase ) = (@_)[1,2]; if( scalar @_ < 3 ) { warn( "gosa_ldap_search needs at least 3 parameters" ); return; }; if( defined $sbase && (length($sbase) > 0) ) { # Check, if $sbase is a base of $base if( $sbase ne substr($base,-1 * length($sbase)) ) { warn( "gosa_ldap_search: (1) '$sbase' isn't the base of '$base'" ); return; } $base = substr( $base, 0, length( $base ) - length( $sbase ) ); # Check, if $base ends with ',' after $sbase strip if( ',' ne substr( $base, -1 ) ) { warn( "gosa_ldap_search: (2) '$sbase' isn't the base of '$base'" ); return; } $base = substr( $base, 0, length($base) - 1 ); $sbase = ',' . $sbase; } else { $sbase = ''; } return( $base, $sbase ); } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # $ldap = Net::LDAP handle # $base = Search base ( i.e.: ou=test,ou=me,ou=very,ou=well ) # $sbase = Stop base ( i.e.: ou=very,ou=well ) # $filter = LDAP filter # $scope = LDAP scope # $subbase = On every $base look into $subbase,$base ( i.e.: ou=do ) # $attrs = Result attributes # # Example searches in: # ou=do,ou=test,ou=me,ou=very,ou=well # ou=do,ou=me,ou=very,ou=well # ou=do,ou=very,ou=well # # Returns (Net::LDAP::Search, $search_base) on LDAP failure # Returns (Net::LDAP::Search, $search_base) on success # Returns undef on non-LDAP failures # sub gosa_ldap_rsearch { use Switch; my ($ldap,$base,$sbase,$filter,$scope,$subbase,$attrs) = @_; ( $base, $sbase ) = gosa_ldap_search_checks( @_ ); return if( ! defined $base ); my (@rdns,$search_base,$mesg); @rdns = gosa_ldap_split_dn( $base ); return if( 0 == scalar @rdns ); while( 1 ) { # Walk the DN tree switch( scalar @rdns ) { case 0 { # We also want to search the stop base, if it was defined return if( ! defined $sbase ); if( length( $sbase ) > 0 ) { $search_base = substr( $sbase, 1 ); } else { $search_base = ''; } undef( $sbase ); } else { $search_base = join( ',', @rdns ); shift(@rdns); $search_base .= $sbase; } } # Initialize hash with filter my %opts = ( 'filter' => $filter ); # Set searchbase if( defined $subbase && $subbase ) { $opts{ 'base' } = "${subbase},${search_base}" } else { $opts{ 'base' } = "${search_base}" } # Set scope $opts{ 'scope' } = "$scope" if( defined $scope && $scope ); $opts{ 'attrs' } = @$attrs if( defined $attrs ); # LDAP search # The referral chasing is much simpler then the OpenLDAP one. # It's just single level support, therefore it can't really # chase a trail of referrals, but will check a list of them. my @referrals; my $chase_referrals = 0; RETRY_SEARCH: $mesg = $ldap->search( %opts ); if( LDAP_REFERRAL == $mesg->code ) { # Follow the referral if( ! $chase_referrals ) { my @result_referrals = $mesg->referrals(); foreach my $referral (@result_referrals) { my $uri = new URI( $referral ); next if( $uri->dn ne $opts{ 'base' } ); # But just if we have the same base push( @referrals, $uri ); } $chase_referrals = 1; } NEXT_REFERRAL: next if( ! length @referrals ); my $uri = new URI( $referrals[ 0 ] ); $ldap = new Net::LDAP( $uri->host ); @referrals = splice( @referrals, 1 ); goto NEXT_REFERRAL if( ! defined $ldap ); $mesg = $ldap->bind(); goto NEXT_REFERRAL if( 0 != $mesg->code ); goto RETRY_SEARCH; } if( LDAP_NO_SUCH_OBJECT == $mesg->code ) { # Ignore missing objects (32) goto NEXT_REFERRAL if( scalar @referrals ); next; } return $mesg if( $mesg->code ); # Return undef on other failures last if( $mesg->count() > 0 ); } return( $mesg, ${search_base} ); } #------------------------------------------------------------------------------ # See gosa_ldap_rsearch # # sbase = start base # # Example searches in: # ou=do,ou=very,ou=well # ou=do,ou=me,ou=very,ou=well # ou=do,ou=test,ou=me,ou=very,ou=well # sub gosa_ldap_fsearch { use Switch; my ($ldap,$base,$sbase,$filter,$scope,$subbase,$attrs) = @_; ( $base, $sbase ) = gosa_ldap_search_checks( @_ ); return if( ! defined $base ); my (@rdns,$search_base,$mesg,$rdn_count); @rdns = reverse gosa_ldap_split_dn( $base ); $rdn_count = scalar @rdns; return if( 0 == $rdn_count ); while( 1 ) { # Walk the DN tree if( ! defined $search_base ) { # We need to strip the leading ",", which is needed for research if( length( $sbase ) > 0 ) { $search_base = substr( $sbase, 1 ); } else { $search_base = ''; } } elsif( 0 == scalar @rdns ) { return undef; } else { $search_base = $rdns[ 0 ] . ',' . $search_base; shift(@rdns); } # Initialize hash with filter my %opts = ( 'filter' => $filter ); # Set searchbase if( defined $subbase && $subbase ) { $opts{ 'base' } = "${subbase},${search_base}"; } else { $opts{ 'base' } = "${search_base}"; } # Set scope $opts{ 'scope' } = "$scope" if( defined $scope && $scope ); $opts{ 'attrs' } = @$attrs if( defined $attrs ); # LDAP search $mesg = $ldap->search( %opts ); next if( $mesg->code == 32 ); # Ignore missing objects (32) return $mesg if( $mesg->code ); # Return undef on other failures last if( $mesg->count() > 0 ); } return( $mesg, ${search_base} ); } #------------------------------------------------------------------------------ # # $search_result = Net::LDAP::Serach # $get_entry = boolean # # if $get_entry == true, return $entry # == false, return 1 # # returns 0 on failure # sub gosa_ldap_is_single_result { my ($search_result,$get_entry) = @_; my $result = 0; if( (defined $search_result) && (0 == $search_result->code) && (1 == $search_result->count()) ) { if( defined $get_entry && $get_entry ) { $result = ($search_result->entries())[ 0 ]; } else { $result = 1; } } return $result; } #------------------------------------------------------------------------------ sub gosa_array_find_and_remove { my ($haystack,$needle) = @_; my $index = 0; foreach my $item (@$haystack) { if ($item eq $needle) { @$haystack = splice( @$haystack, $index, 1 ); return 1; } $index++; } return 0; } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Parse options from array into hash # # Copied from Net::LDAP # sub gosa_options_parse { my %ret = @_; my $once = 0; for my $v (grep { /^-/ } keys %ret) { require Carp; $once++ or Carp::carp("deprecated use of leading - for options"); $ret{substr($v,1)} = $ret{$v}; } $ret{control} = [ map { (ref($_) =~ /[^A-Z]/) ? $_->to_asn : $_ } ref($ret{control}) eq 'ARRAY' ? @{$ret{control}} : $ret{control} ] if exists $ret{control}; \%ret; } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Generate a random string based on a symbolset # # @param int $strlen: length of result string # @param array ref: symbol set (optional) # @return string or undef # sub gosa_gen_random_str { my ($strlen, $symbolset) = @_; return if( (! defined $strlen) || (0 > $strlen) ); return '' if( 0 == $strlen ); if( (! defined $symbolset) || ('ARRAY' ne ref( $symbolset )) || (0 >= scalar( @$symbolset )) ) { my @stdset = (0..9, 'a'..'z', 'A'..'Z'); $symbolset = \@stdset; } my $randstr = join '', map @$symbolset[rand @$symbolset], 0..($strlen-1); return $randstr; } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Get a lockfile and check for already running processes # # @param string $cmd: application name to check in proc # @param string $pidfile: lockfile name # @return undef, $errstr or LOCKFILE handle # sub gosa_get_pid_lock { my( $cmd, $pidfile ) = @_; my( $LOCK_FILE, $pid ); # Check, if we are already running if( open($LOCK_FILE, "<$pidfile") ) { $pid = <$LOCK_FILE>; if( defined $pid ) { chomp( $pid ); if( -f "/proc/$pid/stat" ) { my($stat) = `cat /proc/$pid/stat` =~ m/$pid \((.+)\).*/; if( "$cmd" eq $stat ) { close( $LOCK_FILE ); return( undef, "Already running" ); } } } close( $LOCK_FILE ); unlink( $pidfile ); } # Try to open PID file if (!sysopen($LOCK_FILE, $pidfile, O_WRONLY|O_CREAT|O_EXCL, 0644)) { my $msg = "Couldn't obtain lockfile '$pidfile': "; if (open($LOCK_FILE, '<', $pidfile) && ($pid = <$LOCK_FILE>)) { chomp($pid); $msg .= "PID $pid"; } else { $msg .= $!; } return( undef, $msg ); } return( $LOCK_FILE ); } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Dynamically load perl modules as plugins # # @param string $modules_path: directory for module lookup # @param string $reg_function: function name to call for registration # @param string $reg_params: perl parameters for the function call # @param sub $reg_init: function to call with the result of the registration # result will be saved as the value of # $registered_modules{ $mod_name } # @return hashref of registered modules, arrayref of error strings or undef # sub gosa_load_modules { my( $modules_path, $reg_func, $reg_params, $reg_init ) = @_; my %registered_modules; my @errors; my $errorref = \@errors; $reg_params = '' if( ! defined $reg_params ); if( ! opendir (DIR, $modules_path) ) { push( @errors, "ERROR while loading modules from directory $modules_path : $!\n" ); return( undef, \@errors ); } my $abs_modules = abs_path( $modules_path ); push( @INC, $abs_modules ); while (defined (my $file = readdir (DIR))) { next if( $file !~ /([^\.].+)\.pm$/ ); my $mod_name = $1; eval "require '$file';"; if ($@) { my $import_error = $@; push( @errors, "ERROR: could not load module $file" ); for my $line (split( "\n", $import_error )) { push( @errors, " perl: $line" ); } } else { my $result = eval( "${mod_name}::${reg_func}(${reg_params});" ); if( (! $@) && $result ) { $result = $reg_init->( $mod_name, $result ) if( defined $reg_init ); $registered_modules{ $mod_name } = $result; } else { push( @errors, $@ ); } } } close (DIR); for( my $i = 0; $i < scalar @INC; $i++ ) { if( $INC[ $i ] eq $abs_modules ) { splice( @INC, $i, 1 ); last; } } $errorref = undef if( ! scalar @errors ); return( \%registered_modules, \@errors ); } END {} 1; __END__ # vim:ts=2:sw=2:expandtab:shiftwidth=2:syntax:paste gosa-perl/Makefile.PL0000644000175000017500000000076111326407245014253 0ustar benoitbenoituse 5.006; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'GOsa', 'VERSION_FROM' => 'GOsa/Common.pm', # finds $VERSION 'PREREQ_PM' => {}, ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT => 'LHM perl library', # retrieve abstract from module AUTHOR => 'Jan-Marek Glogowski ') : ()), ); gosa-perl/MANIFEST0000644000175000017500000000003311326407245013422 0ustar benoitbenoitGOsa/Common.pm GOsa/FAI.pm