Community Company Search Contact

coe_profiles.in from LinuxCOE at Krugle

Show coe_profiles.in syntax highlighted

#!/usr/bin/perl
#############################################################################################
# File:         coe_profiles
# Description:  script to manage LinuxCOE system Designer Profiles
# Author:       Lee Mayes   ( email leem@hp.com )
# Created:      31 Jan 2001 
# Language:     perl
# Package:      LinuxCOE
##############################################################################################
# © Copyright 2000-2007 Hewlett-Packard Development Company, L.P
#
# 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, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
##############################################################################################
use strict;
my $debug = 0;
my $nonav = 0;
use CGI;
my $q = new CGI qw();
use lib qw (@prefix@/lib);
use LinuxCOE;
my $db = new LinuxCOE;
$db->debug($debug);

$db->nonav($nonav);
my $COE_VER=$db->def('COE_VER');
my @vars = qw(defs);
my $bootimageurl = "/@PACKAGE_NAME@-cgi-bin/coe_bootimage";
my $profileurl = "/@PACKAGE_NAME@-cgi-bin/coe_profiles";

# Override defaults if requested 

my $defs = $q->param('defs');
if ( $defs ) {
  $db->LoadDefs($defs);
  $bootimageurl .= "?defs=$defs";
  $profileurl .= "?defs=$defs";
}
$db->InitDB;
my $docroot = $db->docroot;
my $default = $db->def('DIST');
$default .= " - " . $db->def('ARCH');   

# URL mangling - Force SSL?
# Depending on SECURITY_LEVEL and what's being done, switch to SSL if passwd's are being passed
 
# Which actions require SSL?
my @sec_act = qw (Create Modify Delete);
my $action = $q->param('action');
my $os = $db->clean_var($q->param('os'));

my $sec_level = $db->def('SECURITY_LEVEL');
my $host = `/bin/hostname`;
chomp $host;
my $securehost = $db->def('SSLHOST') || (gethostbyname($host))[0];
my $defhost =  $db->def('HOSTNAME') || (gethostbyname($host))[0];
my $url = $q->self_url;
if (( $url =~ /http:/ ) && (( $sec_level eq 'SECURE' ) || (($sec_level eq 'NORMAL') && ( grep(/^$action$/,@sec_act))) )) {
  if ($defs) {
    print $q->redirect("https://${securehost}$profileurl&action=$action&os=$os");
  } else {
    print $q->redirect("https://${securehost}$profileurl?action=$action&os=$os");
  }
  exit;
} else {
  print $q->header;
}

# The profile section seperators

my $bundle_header = $db->bundle_header;
my $rpm_header = $db->rpm_header;
my $part_header = $db->part_header;
my $misc_header = $db->misc_header;
my $final_header = $db->final_header;
my $coe_bundle_header = $db->coe_bundle_header;

my ($dist,$ver,$arch);
$arch = $db->clean_var($q->param('arch'));
unless ( $arch ) {
  $os = $q->param('os');
  ($os,$arch) = split(' - ',$os);
  $q->param('os',$os);
  $q->param('arch',$arch);
  #print STDERR "First time, splitting $os and $arch\n";
}
($dist,$ver) = split(' ',$os);

# MAIN

# Based on what action (delete/create/etc), call appropriate subroutine

if    ( $action eq '' )				{ &ShowChoices }
elsif ( $q->param('os') =~ /^Mandr/ )		{ &NoGo }  # Temp stub for development
elsif ( $q->param('os') eq '' )			{ &end_it_now("You must choose a distribution!") }
if ( $action eq 'Create' )			{ &ShowMe }
elsif ( $action eq 'Display' )			{ &Display }
elsif ( $action eq 'Delete' )			{ &Display }
elsif ( $action eq 'Delete_It' )		{ &Delete }
elsif ( $action eq 'Modify' )			{ &ShowForm }
elsif ( $action eq 'update' )			{ &ConfirmIt }
elsif ( $action eq 'create' )			{ &StoreIt }
elsif ( $action eq 'MailIt' ) 			{ &MailIt }
else             	                        { &end_it_now("Not implemented yet!")}
# End if MAIN

sub MailIt {

  use lib qw (@prefix@/includes);
  use binaries;
# Send email to the owner containing the 'forgotten' profile password

  my $profile = $q->param('profile');
  my ($owner,$password,$file) = $db->profile_details($dist,$ver,$arch,$profile);
  unless ($owner) {
    &end_it_now("Major DB ERROR! $profile for $os has no owner?!?!?!");
  }
  my $admin = $db->mailaddr;
  if (! open ( MAIL, "| $SENDMAIL -F \"LinuxCOE $COE_VER System Designer\" -t")) {
    &end_it_now("Error forking sendmail : $!");
  }
  print MAIL "Reply-To: $admin ( LinuxCOE )\n";
  print MAIL "Subject: Your $os $profile password request\n";
  print MAIL "To: $owner\n";
  print MAIL qq[
Hello $owner,

  You received this message because someone has requested the password
for the following profile which is registered to you. You will be the only 
one sent this message.

Operating System:  $os
Profile Name:      $profile
Password:          $password

Best Regards,

The LinuxCOE System Designer
];
  close(MAIL);
  print $db->ShowNav("Mail the password");
  print $q->h3("Mail Sent");
  print "<P>Password for $os $profile sent to $owner.</P>\n";
  print "As they say, your <i>check's in the mail</i>.\n";
  print $q->end_html;
  $db->ShowFooter;
  exit;

} # End of MailIt

sub Delete {

# If the passwords match, delete this profile!

  my $profile = $q->param('profile');
  my $passwd = $q->param('password');
  unless ( $db->check_passwd($profile,$dist,$ver,$passwd,$arch) ) {
    my $owner = $db->errmsg;
    &bad_pass($os,$profile,$owner);
  }

# Delete the file

  my $file = $db->get_filename($dist,$ver,$arch,$profile);
  $file = $db->profbase . "/$file";
  unlink($file);

# Delete the DB entry

  $db->delete_profile($dist,$ver,$arch,$profile);

# Generate all is well HTML

  my $title = "$os $profile Deleted!";
  $db->ShowNav($title);
  $title .= " - <font color=red>$defs</font>" if ($defs);
  print $q->h3("$title");
  print qq[<A HREF="http://${defhost}$profileurl">Back to LinuxCOE System Designer Profile Managment</A>\n];
  print $q->end_html;
  $db->ShowFooter;
  exit;

} # End of Delete

sub Display {

# If called with a profile, display, otherwise, prompt for one to display

  my $profile = $q->param('profile');

  if ( $profile ) {  # just display it!

    my $title = "LinuxCOE $COE_VER System Configuration - Display $profile";
    $db->ShowNav($title);
    $title .= " - <font color=red>$defs</font>" if ($defs);
    print $q->h3($title);
    print "<hr>\n";
    &display_profile($profile,$dist,$ver);
    print "<hr>\n";
    print "<P> Now you may either ";
    print "<a href=http://${defhost}$profileurl>Return to the LinuxCOE profile manager</a></p>\n";
    print "<p><ul><b>or</b></ul>\n";
    print "continue on to "; 
    print "<a href=http://${defhost}$bootimageurl>create a network installation boot image</a></p>\n";
    print "<p>Your profile has been saved on this server such that you can
           use it as a template to create localized network installation boot
	   floppies/CDs.  You are advised to print or save the previous page  
           [pres Back], just in case something happens to your profile here.
	   .\n";  
    print $q->end_html;
    $db->ShowFooter;    
    exit;

  } else {           # prompt for a profile

# Prompt for a valid profile for this OS

    my $title = "LinuxCOE $COE_VER System Configuration - Choose Profile";
    $db->ShowNav($title);
    $title .= " - <font color=red>$defs</font>" if ($defs);
    print $q->h3($title);
    print $q->start_form('POST',$profileurl);
    &do_hidden;
    print $q->hidden(-name=>'os', -default=>$os);   
    print $q->hidden(-name=>'arch', -default=>$arch);   
    $q->delete_all;
    if ( $action eq 'Delete' ) {
      print $q->hidden(-name=>'action', -default=>'Delete_It');   
    }
    print qq[<P>Select Profile: <SELECT NAME="profile"><OPTION VALUE="">Required\n];
    my @profiles = $db->show_profiles($dist,$ver,$arch);
    foreach my $profile (@profiles) {
      print "<OPTION>$profile\n";
    }
    print "</SELECT></P>\n";
    if ( $action eq 'Delete' ) {
      print "<P>Enter password for profile:\n";
      print qq[<INPUT NAME="password" SIZE=12 TYPE="PASSWORD"></P>];
      print $q->submit(-name=>'submit',-value=>'Delete this profile');  
    } else {
      print $q->submit(-name=>'action',-value=>'Display');  
    }
    print $q->end_form;
    print $q->end_html;
    $db->ShowFooter;    
    exit;

  }  # End of show profile choices

} # End of Display

sub NoGo { 

  my $msg = "The Mandriva release is not currently supported by the LinuxCOE System Designer using profiles.<P>";
  &end_it_now("$msg") 

}

sub StoreIt {

# Drain parameters

  my $profile = $q->param('profile');
  my $parts = $q->unescape($q->param('parts'));
  my $misc = $q->unescape($q->param('misc'));
  my $rpms = $q->param('rpms');
  my $final = $q->unescape($q->param('final'));
  my $base = $q->param('base');
  my @bundles = $q->param('bundles');
  my @coe_bundles = $q->param('coe_bundles');
  my $patch_me = $q->param('patch_me');
  my $patch_freq = $q->param('patch_freq');
  my $patch_method = $q->param('patch_method');
  push(@bundles,"BASE: $base") if $base;

# Write the file

  my $filename = $db->Store_It($profile,$arch,$dist,$ver,$parts,$misc,$final,$rpms,$patch_me,$patch_freq,\@coe_bundles,\@bundles,$patch_method);
  unless ( $filename ) { &end_it_now($db->errmsg) }
  $filename = $db->profbase . "/$filename";

# Update the database

  my $sql;
  my $update = $q->param('update');
  if ( $update != 1 ) {

    #print STDERR "StoreIT calling add_profile\n";
    $db->add_profile($dist,$ver,$arch,$profile,$q->param('owner'),$q->param('password'),$filename);
    $update = "created";

  } else {

    use lib qw (@prefix@/includes);
    use binaries;
    $update = "modified";
    my ($owner,$password,$file) = $db->profile_details($dist,$ver,$arch,$profile);
    unless ($owner) {
      &end_it_now("Major DB ERROR! $profile for $os has no owner?!?!?!");
    }
    my $admin = $db->mailaddr;
    if (! open ( MAIL, "| $SENDMAIL -F \"LinuxCOE $COE_VER System Designer\" -t")) {
      &end_it_now("Error forking sendmail : $!");
    }
    print MAIL "Reply-To: $admin ( LinuxCOE )\n";
    print MAIL "Subject: Your $os $arch $profile has been modified\n";
    print MAIL "To: $owner\n";
    print MAIL qq[
  Hello $owner,
  
    You received this message because a profile registered to you has been
  modified. You will be the only one sent this message.
  
  Operating System:  $os
  Architecture:      $arch
  Profile Name:      $profile

<NEW
>ORIGINAL

];

  my $esc_file = $filename;
  $esc_file =~ s/\W/\\$&/g;
  print STDERR "Mailing diff of $DIFF ${esc_file}.new $esc_file\n" if $debug;
  open(DIFF,"$DIFF ${esc_file}.new $esc_file |");
  while(<DIFF>) { print MAIL }
  close(DIFF);

  print MAIL qq[
  Best Regards,
  
  The LinuxCOE System Designer
];
  close(MAIL);

  }
  rename "${filename}.new","$filename";
  print STDERR qq[StoreIt: rename "${filename}.new","$filename";\n] if $debug;

# Send HTML saying it werked

  my $title = "$os $profile $update sucessfully";
  $db->ShowNav($title);
  $title .= " - <font color=red>$defs</font>" if ($defs);
  print $q->h4($title);
  print "Now you may either ";
  print "<a href=http://${defhost}$profileurl>Return to the LinuxCOE profile manager</a><p>\n";
  print $q->p("<ul><b>or</b></ul>\n");
  print "continue on to "; 
  print "<a href=http://${defhost}$bootimageurl>create a network installation boot image</a><p>\n";
  print "<p>Your profile has been saved on this server such that you can
         use it as a template to create localized network installation boot
	 floppies/CDs.  You're advised to print the previous page (use the 
         back button in your browser) as a redundant backup.
	 \n";
  print $q->end_html;
  $db->ShowFooter;    
  exit;

} # End of StoreIt

sub ConfirmIt {

# Check the profile modifications for sanity...

  my $profile = $q->param('profile');
  $profile =~ s/\ *$//;  # Truncate trailing spaces....
  $q->delete('profile');
  $q->param('profile',$profile);
  my ($dist,$ver) = split(' ',$os);
  unless ( $profile ) { &end_it_now('You must enter a valid profile name!') }
  if ( $profile eq 'Profile Name' ) {
    &end_it_now("You must enter a profile name!");
  }
  my @bundles = $q->param('bundles');
  my $test = $bundles[0];
  my $bundles;
# If called with nothing, poke in a reasonable default if applicable
  if ( $test ) {
    $bundles = join("\n@ ",@bundles);
    $bundles = "@ $bundles\n";
  } elsif ( $dist eq 'VMWare' ) {
    if ( $ver lt 'ESX-3.0.0' ) {
      $bundles = "@ ESX Server\n@ ESX Extras\n";
      @bundles = ('ESX Server','ESX Extras');
      $q->param('bundles','ESX Server','ESX Extras');
    } else {
      $bundles = "@ Base\n";
      @bundles = ('Base');
      $q->param('bundles','Base');
    }
  }
  my @coe_bundles = $q->param('coe_bundles');
  my $coe_bundles = join("\n",@coe_bundles);
  my $rpms = $q->param('rpms');
  my $parts = $q->param('parts');
  my $misc = $q->param('misc');
  my $final = $q->param('final');
  my $patch_me = $q->param('patch_me');
  my $patch_freq = $q->param('patch_freq');
  my $patch_method = $q->param('patch_method');
  my $base = $q->param('base');


# Do some simple reality checking on disk partition

  unless ( $db->validate_parts($parts) ) {
    &end_it_now($db->errmsg);
  }

# escape quotes and such or you can't hide them

  $parts = $q->escape($parts);
  $misc = $q->escape($misc);
  $final = $q->escape($final);

# Check database, update or creation?

  my ($update,@rest) = $db->profile_details($dist,$ver,$arch,$profile);
  my ($password,$owner);
  if ( $update ) {
    my $passwd = $q->param('password');
    unless ( $db->check_passwd($profile,$dist,$ver,$passwd,$arch) ) {
      my $owner = $db->errmsg;
      &bad_pass($os,$profile,$owner);
    }
  } else {
    $owner = $q->param('email');
    unless ($owner) { &end_it_now("You must specify a list profile owner!") }
    $password = $q->param('password');
    unless ($password) { &end_it_now("You must supply a password!") }
    my $pass = $q->param('password1');
    unless ( $password eq $pass ) { &end_it_now("Your passwords do not match!") }
  }

# Dump the validated profile for user confirmation

  my $title = "$profile - profile validation successful";
  $db->ShowNav($title);
  $title .= " - SAVE IT IF IT LOOKS OK!";
  $title .= " - <font color=red>$defs</font>" if ($defs);
  print $q->h3($title);
  print $q->start_form('POST',$profileurl);
  &do_hidden;
  if ( $update ) {
    print $q->submit(-value=>"Save $os $profile");
    print " or go <b>back</b> and make changes.\n";
  } else {
    print $q->submit(-value=>'Looks good, save this profile');
    print " or go <b>back</b> and make some changes\n";
  }
  &display_profile($profile,$dist,$ver,'NEW');
  print $q->hr."\n";
  $q->delete_all;
  print $q->hidden(-name=>'owner', -default=>$owner)."\n";
  print $q->hidden(-name=>'password', -default=>$password)."\n";
  print $q->hidden(-name=>'os', -default=>$os)."\n";
  print $q->hidden(-name=>'arch', -default=>$arch)."\n";
  print $q->hidden(-name=>'parts', -default=>$parts)."\n";
  print $q->hidden(-name=>'misc', -default=>$misc)."\n";
  print $q->hidden(-name=>'profile', -default=>$profile)."\n";
  print $q->hidden(-name=>'bundles', -default=>\@bundles)."\n";
  print $q->hidden(-name=>'coe_bundles', -default=>\@coe_bundles)."\n";
  print $q->hidden(-name=>'rpms', -default=>$rpms)."\n";
  print $q->hidden(-name=>'final', -default=>$final)."\n";
  print $q->hidden(-name=>'patch_me', -default=>$patch_me)."\n";
  print $q->hidden(-name=>'patch_freq', -default=>$patch_freq)."\n";
  print $q->hidden(-name=>'patch_method', -default=>$patch_method)."\n";
  print $q->hidden(-name=>'base', -default=>$base)."\n";
  print $q->hidden(-name=>'action', -default=>'create')."\n";
  if ( $update ) {
    print $q->hidden(-name=>'update', -default=>1);
    print $q->submit(-value=>"Save $os $profile");
    print " or go <b>back</b> and make changes.\n";
  } else {
    print $q->submit(-value=>'Looks good, save this profile');
    print " or go <b>back</b> and make some changes\n";
  }
  print $q->end_form,$q->end_html;
  $db->ShowFooter;
  exit;

}  # End of ConfirmIt

sub ShowMe {

# Dump out a form letting them choose an existing profile to edit
# OR create a new one.

  unless ( $os ) {
    &end_it_now("You <B>MUST</B> chose an Distribution and Revision!");
  }
  my $profile = $q->param('profile');
 
  if ($profile) {
    
    my $title = "Modify $os $profile";
    $db->ShowNav($title);
    $title .= " - <font color=red>$defs</font>" if ($defs);
    print $q->h3($title);
    print "\n";

  } else {

    my $title = "Create a LinuxCOE Profile for $os";
    $db->ShowNav($title);
    $title .= " - <font color=red>$defs</font>" if ($defs);
    print $q->h3($title);
    print $q->h3("Load an existing LinuxCOE system profile for a starter?");   
    print "You may optionally load the values in an existing $os profile:"; 
    print $q->start_form('POST',$profileurl);
    &do_hidden;
    print "\n";
    print $q->hidden(-name=>'os', -default=>$os);
    print $q->hidden(-name=>'arch', -default=>$arch);
    print $q->hidden(-name=>'action', -default=>'missouri');
    print "\n";
  
# Dump some HTML letting them pick one to modify

    print $q->submit(-value=>'Load an existing profile')," -&gt ";
    print qq[<SELECT NAME="load_profile">];
    my @profiles = $db->show_profiles($dist,$ver,$arch);
    foreach my $i (@profiles) { print "<OPTION>$i" }
    print "</SELECT>\n";
    print $q->end_form; 
  
  } 

# OK, create the form they'll mess with

  my ($parts) = $db->make_default_parts($os,$arch);
  my ($misc) = $db->make_default_misc($os,$arch);
  my ($final) = $db->make_default_final($os);
  my (@bundles,$rpms,@coe_bundles,$patch_me,$patch_freq,$patch_method,$b,$c,$base);

# See if this is an edit, if so, override defaults;

  if ( $profile ) {
    ($parts,$misc,$final,$rpms,$patch_me,$patch_freq,$c,$b,$patch_method) = $db->parse_profile($profile,$arch,$ver,$dist);
    unless ( $parts ) {
      &end_it_now($db->errmsg);
    }
    @bundles = @{$b};
    @coe_bundles = @{$c};
  }
  my $loadit = $q->param('load_profile');
  if ( $loadit ) {
    ($parts,$misc,$final,$rpms,$patch_me,$patch_freq,$c,$b,$patch_method) = $db->parse_profile($loadit,$arch,$ver,$dist);
    unless ( $parts ) {
      &end_it_now($db->errmsg);
    }
    @bundles = @{$b};
    @coe_bundles = @{$c};
  }

  if ( $dist eq 'SuSE' ) {
    my @newbund;
    foreach my $bund (@bundles) {
      if ( $bund =~ /BASE: / ) {
        $base = $bund;
        $base =~ s/BASE: //;
      } else {
        push(@newbund,$bund);
      }
    }
    @bundles = @newbund;
  }



# Dump the HTML to let them edit the profile
  print $q->start_form(-action=>$profileurl,-name=>'form');
  &do_hidden;
  #print $q->start_form('POST','/@PACKAGE_NAME@-cgi-bin/echo');
  $q->delete('action');
  print $q->hidden(-name=>'action', -default=>'update');
  print $q->hidden(-name=>'os', -default=>$os);
  print $q->hidden(-name=>'arch', -default=>$arch);
  if ( $profile ) {
    print $q->h3("Modify $os profile $profile");
    print "\n";
    print $q->hidden(-name=>'profile', -default=>$profile);    
    print "\n";
  } else {
    print "\n";
    print $q->h3("Select a name for your profile");
    my $prof = $q->param('profile') || "Enter Profile Name";
    print "Your new profile name:<br>\n";
    print  $q->textfield(-name=>'profile',-default=>'Profile Name',-size=>20,maxlength=>20);
    print "\n";
  }
  my ($dist,$ver) = split(' ',$os);
  if ( $dist eq 'VMWare' ) { 
    print $q->hidden(-name=>'bundles', -default=>'');
    print $q->hidden(-name=>'rpms', -default=>'');
  } else {
    $db->Check_Me;
    print $q->h3("Software package selection");
    print "\n<TABLE>\n<tr>\n\n<td valign=top>\n";
    $db->Display_Bundles($os,$arch,\@bundles,$base);
    print "</td>\n<td valign=top>\n";
    $db->Display_RPMS($os,$arch,$rpms);
    print "\n</td></tr>\n</TABLE>\n";
  }
  my @NAMES = split(' ',$db->def('ADDONS'));
  foreach my $NAME (@NAMES) {
    $db->Display_COE_Bundles($os,$arch,\@coe_bundles,$NAME);
  }
  my ($distro,$version) = split(' ',$os);
  $db->Show_Patch($distro,$version,$patch_me,$patch_freq,$arch,$patch_method);
  $db->Display_Disk_Partition($os,$arch,$parts);
  if (( $os =~ /RedHat/ ) || ( $os =~ /Fedora/ ) || ( $os =~ /VMWare/ ) || ( $os =~ /Scient/ ) || ( $os =~ /CentOS/ )) {
    $db->Display_Misc_Box($os,$arch,$misc);
  }
  $db->Display_Final($os,$arch,$final);
  print $q->p("\n");
  if ( $profile ) {
    print "<P>Enter the password for this profile:\n";
    print qq[<INPUT NAME="password" SIZE=12 TYPE="PASSWORD"></P>];
    print $q->submit(-value=>'Validate this system profile');  
  } else {
    print "<P>Enter your email address: "; 
    print  $q->textfield(-name=>'email',-size=>30,maxlength=>50);
    print "<BR>Enter the password for this profile:\n";
    print qq[<INPUT NAME="password" SIZE=12 TYPE="PASSWORD">];
    print "<BR>Reenter the password for this profile:\n";
    print qq[<INPUT NAME="password1" SIZE=12 TYPE="PASSWORD"></P>];
    print $q->submit(-value=>'Validate this system profile');  
  } 
  print "&nbsp; &nbsp;\n";
  print $q->reset(-value=>'Reset form'),$q->p;      
  print $q->end_form,$q->end_html;
  $db->ShowFooter;
  exit;

}

sub ShowChoices {

# Simply dump a form asking for Distro and Revisions

  my $title = "LinuxCOE $COE_VER System Designer";
  $db->ShowNav($title);
  $title = "Welcome to the LinuxCOE System Designer profile manager!";
  $title .= " - <font color=red>$defs</font>" if ($defs);
  print $q->h3("$title");
  print $q->p("The LinuxCOE System Designer allows you to design a Linux
  system profile which can be downloaded onto a single boot image.
  When inserted into a target system, the boot image will automatically
  build the system per your design -- all hands free, all via the network,
  no media required.\n");   

  print $q->start_form('POST',$profileurl);
  &do_hidden;
  $q->delete_all;

  print "Select your Distribution, Revision and Architecture: ";
  print qq[<SELECT NAME="os">];
  foreach my $os ($db->show_os) {
     if ( $os eq $default ) {
       print "<OPTION SELECTED>$os\n";
     } else {
       print "<OPTION>$os\n";
     }
  }
  print "</SELECT><P>\n";
  print "<TABLE BORDER=0>\n";
  print "<TR><TH ALIGN=LEFT>";
  print $q->submit(-name=>'action',-value=>'Display');  
  print "</TH><TD ALIGN=LEFT>an existing LinuxCOE Profile</TD></TR>\n";

  print "<TR><TH ALIGN=LEFT>";
  print $q->submit(-name=>'action',-value=>'Create');  
  print "</TH><TD ALIGN=LEFT>a new LinuxCOE Profile</TD></TR>\n";

  print "<TR><TH ALIGN=LEFT>";
  print $q->submit(-name=>'action',-value=>'Modify');  
  print "</TH><TD ALIGN=LEFT>an existing LinuxCOE Profile</TD></TR>\n";

  print "<TR><TH ALIGN=LEFT>";
  print $q->submit(-name=>'action',-value=>'Delete');  
  print "</TH><TD ALIGN=LEFT>an existing LinuxCOE Profile</TD></TR>\n";

  print $q->end_form;
  print "</TABLE><P>\n";
  print $q->end_html;
  $db->ShowFooter;
  exit;

} 

sub ShowForm {

# Simply dump a form asking for Distro and Revisions

  my $title = "Select a $os Profile to Modify";
  $db->ShowNav($title);
  $title .= " - <font color=red>$defs</font>" if ($defs);
  print $q->h3($title);
  print "Note: The password for this profile <B>will</B> be required for modification!\n";

# Create a list of profiles valid for this distro/ver

  print $q->start_form('POST',$profileurl);
  &do_hidden;
  $q->delete_all;
  print $q->hidden(-name=>'os', -default=>$os);
  print $q->hidden(-name=>'arch', -default=>$arch);
  print $q->hidden(-name=>'action', -default=>'Create');
  print qq[<P><SELECT NAME="profile"><OPTION VALUE="">Required];
  my @profiles = $db->show_profiles($dist,$ver,$arch);
  foreach my $profile (@profiles) { print "<OPTION>$profile\n" }
  print "</SELECT></P>\n";
  print $q->submit(-name=>'submit',-value=>"Modify Profile");  
  print $q->end_form;
  $db->ShowFooter;
  print $q->end_html;   
  $db->ShowFooter;
  exit;

} # End of ShowForm

sub end_it_now {
 
# Exit with extreme predjudice
 
  my $errmsg = shift(@_);
  $db->ShowNav("LinuxCOE $COE_VER System Designer Error!");
  print $q->h4("$errmsg");
  my $admin = $db->def('SITE_ADMIN');
  print "<hr>If this error message looks bogus, contact <a href=\"mailto:$admin>$admin</a>\n" if $admin;
  print $q->end_html;
  $db->ShowFooter;
  exit;
 
}                     

sub display_profile {

  my ($profile,$dist,$ver,$new) = @_;

  my  ($base,$parts,$misc,$final,$rpms,$b,$c,$patch_me,$patch_freq,@coe_bundles,@bundles,$patch_method);
  if ( $new ) {
   
   $parts = $q->param('parts');
   $misc = $q->param('misc');
   unless ( $parts ) { &end_it_now($db->errmsg) }
   $final = $q->param('final');
   $rpms = $q->param('rpms');
   @bundles = $q->param('bundles');
   @coe_bundles = $q->param('coe_bundles');
   $patch_freq = $q->param('patch_freq');
   $patch_me = $q->param('patch_me');
   $patch_method = $q->param('patch_method');
   $base = $q->param('base');

  } else {

  ($parts,$misc,$final,$rpms,$patch_me,$patch_freq,$c,$b,$patch_method) = $db->parse_profile($profile,$arch,$ver,$dist);        

    unless ( $parts ) { &end_it_now($db->errmsg) }
    @coe_bundles = @{$c};
    @bundles = @{$b};
    #if ( $dist eq 'SuSE' ) {
      #my @newbund;
      #foreach my $bund (@bundles) {
        #if ( $bund =~ /BASE: / ) {
          #$base =~ s/BASE: //;
        #}
      #}
      #@bundles = @newbund;
    #}
    my $bundles = join("\n@ ",@bundles);
    $bundles = "@ $bundles";
    $bundles .= "\n";

  }

  print $q->h4("Disk Partitioning");
#  print $q->escapeHTML($parts);
  my $leepart = $parts;
  $leepart =~ s/&/&amp;/g;
  $leepart =~ s/</&lt;/g;
  $leepart =~ s/>/&gt;/g;
  print "<PRE>\n";
  print "$leepart\n";
  print "</PRE>\n";

  if (( $dist ne 'Debian' ) && ( $dist ne 'SuSE' )) {
    print $q->h4("Misc Kickstart Options");
    print "<PRE>$misc</PRE>";
  }

  print $q->h4("$dist $ver Bundles");
  if ( $base ) {
    print "<PRE>Base -> $base</PRE>\n";
  }
  if ( @bundles ) {
    if ( $dist ne 'Debian' ) {
      print "<PRE>@ ",join("\n@ ",@bundles),"\n</PRE>\n";
    } else {
      print "<PRE>",join("\n",@bundles),"\n</PRE>\n";
    }
  } else {
    print "<P>None</P>\n";
  }

  print $q->h4("COE Bundles");
  if (@coe_bundles) {
    print "<PRE>".join("\n",@coe_bundles)."\n</PRE>";
  } else {
    print "<P>None</P>\n";
  }

  print $q->h4("Patching Selections");
  print "<P>Install all patches during install: <B>";
  if ( $patch_me ) {
    print "YES";
  } else {
    print "NO";
  }
  $patch_freq = 'never' unless ($patch_freq);
  print "</B></P><P>Automatically apply new $dist $ver patches: <B>$patch_freq</B></P>\n";
  print "</B></P><P>Use <B>$patch_method</B> to patch</P>\n" if ( $patch_method);
  

  my $lable;
  if ( $dist ne 'Debian' ) { $lable = 'RPM' }
  else { $lable = 'Deb' }
  print $q->h4("Individual ${lable}'s");
  if ($rpms) {
    print "<PRE>$rpms</PRE>";
  } else {
    print "<P>None</P>\n";
  }

  print $q->h4("Final Script");
  if ( $final ) {
    my $leefinal = $final;
    $leefinal =~ s/&/&amp;/g;
    $leefinal =~ s/</&lt;/g;
    $leefinal =~ s/>/&gt;/g;
    print "<PRE>$leefinal</PRE>";
  } else {
    print "<P>None</P>\n";
  }

} # End of display_profiles

sub bad_pass {

  my ($os,$profile,$owner) = @_;
  my $msg = "<P>Sorry!  The password you entered does not match the password registered.</P>";
  $msg .= "<P>If you have forgotten the password, I can email it to the registered owner of ";
  $msg .= "profile $profile ( $owner )</P>";
  $msg .= $q->start_form('POST',$profileurl);
  $msg .= $q->hidden(-name=>'os', -default=>$os);   
  $msg .= $q->hidden(-name=>'arch', -default=>$arch);   
  $msg .= $q->hidden(-name=>'profile', -default=>$profile);   
  $msg .= $q->submit(-name=>'action',-value=>'MailIt');
  $msg .= " - Please email me the password!";
  $msg .= "<P>If your email address has changed, please open a case with the ServerCOE team!</P>\n";
  $msg .= $q->end_form;
  &end_it_now($msg);
  
} # End of bad_pass

sub do_hidden {

# populate the form with hidden variables if set

  foreach my $var (@vars) {
    if ( $q->param($var) ) {
      print $q->hidden(-name=>"$var", -default=>$q->param($var)),"\n";
    }
  }

}

See more files for this project here

LinuxCOE

The Linux Common Operating Environment (LinuxCOE) facilitates provisioning and lifecycle support of many popular Linux distributions, versions and architectures.

Project homepage: http://sourceforge.net/projects/linuxcoe
Programming language(s): JavaScript,Perl,Shell Script
License: gpl2

  Makefile.am
  Makefile.in
  README
  coe_bootimage.in
  coe_info.in
  coe_profiles.in
  coe_retrofit.in
  nph-coe_image.in
  nph-debian_image.in
  nph-mandriva_image.in
  nph-suse_image.in