gosa-perl/ 0000755 0001750 0001750 00000000000 11330025416 012264 5 ustar benoit benoit gosa-perl/GOsa/ 0000755 0001750 0001750 00000000000 11330025421 013111 5 ustar benoit benoit gosa-perl/GOsa/FAI.pm 0000644 0001750 0001750 00000141176 11326407245 014075 0 ustar benoit benoit # 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.pm 0000644 0001750 0001750 00000044207 11326407245 014723 0 ustar benoit benoit # 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.PL 0000644 0001750 0001750 00000000761 11326407245 014253 0 ustar benoit benoit use 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/MANIFEST 0000644 0001750 0001750 00000000033 11326407245 013422 0 ustar benoit benoit GOsa/Common.pm
GOsa/FAI.pm