Show LinuxCOE.pm.in syntax highlighted
package LinuxCOE;
##############################################################################################
# File: LinuxCOE.pm
# Description: Common functions for LinuxCOE SysDes stuff
# Author: Lee Mayes ( email leem@hp.com )
# Created: Jan 31 2001 ( LinuxCOE System Designer )
# Language: perl
# Package: LinuxCOE
##############################################################################################
# © Copyright 2000-2006 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;
use vars qw ($AUTOLOAD $COE_VER $docroot $q %DB $dbh %defs %OSVEND %tzs);
use CGI;
use Carp;
my $q = new CGI ();
$COE_VER='4.0';
use lib qw (@prefix@/includes);
if ( -r "@prefix@/includes/include.pm" ) {
use lib qw (@prefix@/includes);
}
use sysdes_paths;
my %fields = (
# Appearance
debug => 0, # Initial (LoadDef time) debug stuff
errmsg => '', # return errors
errstr => 0, # pointer for DBIERR
nonav => 0, # set to 1 to turn off HTML lipstick
didtop => 0, # Don't do it twice!
didbot => 0, # Don't do it twice!
tdfont => 'SIZE=2', # What goes in Table Data <FONT> tags
thfont => 'SIZE=4', # What goes in Table Header <FONT> tags
tdtag => 'NOWRAP', # What goes in <TD> tags
thtag => 'NOWRAP', # What goes in <TH> tags
# Markers (if you change them, change the source files too! :)
bundle_header => "# LinuxCOE Bundle Header\n",
rpm_header => "# LinuxCOE RPM Header\n",
part_header => "# LinuxCOE Disk Parition Header\n",
misc_header => "# LinuxCOE Misc Parms Header\n",
final_header => "# LinuxCOE Final Script Header\n",
coe_bundle_header => "# LinuxCOE COEBundle Header\n",
patch_header => "# LinuxCOE Patch Header\n",
# Pathnames
database => 'LinuxCOE',
profbase => "$VAR/profiles",
deffile => "@prefix@/linuxcoe.rc",
coetop => '/var/opt/LinuxCOE',
docroot => '',
);
sub AUTOLOAD {
my $self = shift;
my $type = ref($self) || croak "$self is not an object";
my $name = $AUTOLOAD;
$name =~ s/.*://; # strip fully-qualified portion
unless (exists $self->{"_permitted"}->{$name} ) {
$self->errmsg("Can't access '$name' field in class $type");
print STDERR $self->errmsg if $self->debug;
return;
}
if (@_) { return $self->{$name} = shift; }
else { return $self->{$name}; }
}
sub DESTROY {}
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = { _permitted => \%fields, %fields };
bless ($self, $class);
$self->docroot($ENV{'DOCUMENT_ROOT'});
$self->LoadDefs;
my $logfile = $self->def('LOGFILE');
if ( $logfile ) {
close(STDERR);
open(STDERR,$logfile);
select((select(STDERR),$|=1)[0]);
}
return($self);
}
sub InitDB {
# Open the dababase
my $self = shift;
# Are we GLOBAL (MySQL) or Local (flat files)?
if ( $self->def('DB_NAME') ) {
print STDERR "Loading COEdb.pm....\n" if $self->debug;
eval "use COEdb;";
COEdb->LockIt;
} else {
eval "use COElocal;";
}
my $db = "$VAR/profiles/profile_db";
print STDERR "COElocal dbmopening $db\n" if $self->debug;
dbmopen(%DB,$db,0600);
}
###############
# Utilities
###############
sub find_file {
# This is a simple sub to locate an override in sysconfdir vs. default prefix
my ($self,$file) = @_;
print STDERR "find_file -> looking for $file - " if $self->debug;
if ( $self->def('ALT_DATA') ) {
my $path = $self->def('ALT_DATA');
if ( -r "$path/$file") {
print STDERR "returning $path/$file\n" if $self->debug;
return("$path/$file");
}
}
if ( -r "$ETC/$file" ) {
print STDERR "returning $ETC/$file\n" if $self->debug;
return("$ETC/$file");
} elsif ( -r "$OPT/$file" ) {
print STDERR "returning $OPT/$file\n" if $self->debug;
return("$OPT/$file");
} else {
print STDERR "returning nothing - NOT FOUND\n" if $self->debug;
return(undef);
}
}
sub make_Base {
# Build the %array that will be passed to final_skel to install base stuff/APT/YUM
# These are the things LinuxCOE 'forces' on the users and is 100% optional
#
#
# It'll have up to 3 keys: 'BASE-1','BASE-2','BASE-3', where:
# BASE-1 -> The PRE file entries
# BASE-2 -> The distro/ver/arch specific entries
# BASE-3 -> The POST file entries
my $self = shift;
my ($method,$waystation,$distro,$ver,$arch) = @_;
if (($method eq 'CDROM' ) || ($method eq 'NFS' )) {
$method = $defs{'METHOD'} || "HTTP";
}
my $suff = '';
if (( $distro eq 'Debian' ) || ( $distro =~ /buntu/ )) { $suff = '-DEB' };
$method = lc($method) . '://';
my %array;
my $line = $self->parse_rpm_file('BASE-1',$self->find_file("base/PRE$suff"),$method,$waystation);
$array{'BASE-1'} = $line if ( $line );
$line = $self->parse_rpm_file('BASE-1',$self->find_file("base/PRE-$distro-$ver-$arch"),$method,$waystation);
$array{'BASE-1'} .= " $line" if ( $line );
$line = $self->parse_rpm_file('BASE-2',$self->find_file("base/MID$suff"),$method,$waystation);
$array{'BASE-2'} = $line if ( $line );
$line = $self->parse_rpm_file('BASE-2',$self->find_file("base/MID-$distro-$ver-$arch"),$method,$waystation);
$array{'BASE-2'} .= " $line" if ($line);
$line = $self->parse_rpm_file('BASE-3',$self->find_file("base/POST$suff"),$method,$waystation);
$array{'BASE-3'} = $line if ( $line );
$line = $self->parse_rpm_file('BASE-3',$self->find_file("base/POST-$distro-$ver-$arch"),$method,$waystation);
$array{'BASE-3'} .= " $line" if ( $line );
return(%array);
}
sub parse_rpm_file {
# Parse the file passed returning a line suitable for calling rpm||dpkg -i against
my $self = shift;
my ($key,$file,$method,$waystation) = @_;
print STDERR "parse_rpm_file: Parsing $file for $method $waystation.\n" if $self->debug;
if ( -r "$file" ) {
my $rpms;
open(IN,"$file");
while(my $buf = <IN>) {
print STDERR "Parsing line $buf" if ($self->debug);
chomp($buf);
$buf =~ s/ //g;
next unless ($buf);
next if ($buf =~ /^#/);
$buf =~ s/\@METHOD\@/$method/;
$buf =~ s/\@WAYSTATION\@/$waystation/;
$buf =~ s/\@COE_VER\@/$COE_VER/;
$rpms .= " $buf";
print STDERR " Adding snippet $buf\n" if ($self->debug);
}
if ($rpms) {
print STDERR "parse_rpm_file returning \$array{$key} = $rpms\n" if $self->debug;
return($rpms);
} else {
print STDERR "parse_rpm_file found nothing for $key : $file\n" if $self->debug;
return(undef);
}
}
}
sub do_dns {
# Convert name/ip address into fully qualified hostname
my $self = shift;
my $test = shift;
my ($hostname,$ip);
if ( $test =~ /[a-zA-z]/ ) { # Itza nodename
my($name,$aliases,$type,$len,$thataddr) = gethostbyname($test);
unless ( $name ) {
my $message = qq[
The hostname you entered: <b>$test</b>, cannot be resolved by DNS.<BR>
Please back up and either fully quailfy it, or use its IP address.
];
$self->errmsg($message);
return;
}
$hostname = $name;
my @ips = unpack('C4',$thataddr);
$ip = sprintf("%d.%d.%d.%d",@ips);
} else { # Itza IP address
# Do a quick reality check on IP address if passed
if ( $test =~ /\.$/ ) { return } # no ending it in a .
my @data = split('\.',$test);
for (my $i=0; $i<=3; $i++) {
my $test = shift(@data);
if (( $test < 0 ) || ( $test > 255 )) { return }
}
if ( @data ) { return } # It's just too much IP
use Socket;
$ip = $test;
$hostname = gethostbyaddr(inet_aton($ip),2);
}
return($hostname,$ip);
}
sub get_tzs {
my $self = shift;
# Generate a list of valid TimeZones...
opendir(TZDIR,"/usr/share/zoneinfo");
my @files = sort(readdir(TZDIR));
closedir(DIR);
my @tzs;
foreach my $file (@files) {
next unless ($file =~ /^[A-Z]/);
if ( -d "/usr/share/zoneinfo/$file" ) {
opendir(DIR,"/usr/share/zoneinfo/$file");
my @subs = sort(readdir(DIR));
closedir(DIR);
shift(@subs); shift(@subs);
foreach my $sub (@subs) { push(@tzs,"$file/$sub") }
} else {
push(@tzs,$file);
}
}
return(sort(@tzs));
}
sub CleanUp {
my ($self,$htmlpath,$ftp_dir,$distro,$ver,$arch,$image,$config) = @_;
# If there's a trigger script, execute it now
my $trigger = $defs{'POST_TRIGGER'};
if ( -x "$trigger" ) {
my $triglog = $defs{'POST_LOG'} || $defs{'LOGFILE'};
my $sys = "$trigger $distro $ver $arch $image $config $triglog 2>&1";
print STDERR "CleanUp, calling trigger : $sys\n" if $self->debug;
system($sys);
} elsif ( $trigger ) {
print STDERR "$trigger script specified but not executable!\n";
}
# Remove the any images/stuff leftover from previous runs if > $age seconds old
my $age = $defs{'AGE'} || 1800; # default to 1/2 hour
my $test = time - $age;
my @dirs = ($htmlpath,$ftp_dir);
foreach my $dir (@dirs) {
opendir(DIR,$dir);
my @files = sort(readdir(DIR));
closedir(DIR);
shift(@files); shift(@files);
foreach my $file (@files) {
my $mtime = (stat("$dir/$file"))[9];
if ( $mtime < $test ) {
if ( -d "$dir/$file" ) {
rmdir "$dir/$file";
} else {
unlink "$dir/$file";
}
}
}
}
}
sub get_ip {
# Return hostname's IP address
my ($self,$hostname) = @_;
my($name,$aliases,$type,$len,$thataddr) = gethostbyname($hostname);
return unless ($name);
my @ips = unpack('C4',$thataddr);
return wantarray ? (@ips) : sprintf("%d.%d.%d.%d",@ips);
}
sub random_string {
# Return a randomish string
my ($self,$length,$string) = @_;
my @array = ( 'A'..'Z','a'..'z','0'..'9' );
my $size = @array;
for (my $i = 0; $i<$length; $i++) {
my $index = int(rand($size));
$string .= $array[$index];
}
return($string);
}
####################
# Parsing Stuff
####################
sub is_filesys_initrd {
# Return true if initrd.img is a mountable filesys, probably should
# just call file on it, but that's yet another fork. Use a map file
# that contains legacy dist/ver info, they'll slowly fall out of support
my $self = shift;
my ( $indist,$inver,$inarch ) = @_;
my ($testver,@rest) = split('-',$inver);
my $mapfile = $self->find_file("data/filesys_initrd.map");
open(MAP,$mapfile);
while(<MAP>) {
chomp;
next if /^#/;
next unless $_;
my ($dist,$ver) = split;
if (($indist eq $dist) && (($testver eq $ver) || ($ver eq 'ALL'))) {
close(MAP);
return(1);
}
}
close(MAP);
return(0);
}
sub get_filename {
# Usage : get_filename(dist,ver,arch,name);
# Generate the profile's filename
my $self = shift;
my ( $dist,$ver,$arch,$profile ) = @_;
my $base = "$VAR/profiles";
$profile =~ s/\//\%fslash\%/g;
my $file = "$dist/$ver/$arch/profiles/$profile";
unless ( -d "$base/$dist/$ver/$arch/profiles" ) {
system "/bin/mkdir -p $base/$dist/$ver/$arch/profiles";
}
print STDERR "get_filename returning $file!\n" if $self->debug;
return($file);
}
sub parse_profile {
# Open an existing profile, parse out the 5 main parts, and return them
my $self = shift;
my ($profile,$arch,$ver,$dist) = @_;
my $file = $self->get_filename($dist,$ver,$arch,$profile);
$file = $self->profbase . "/$file";
unless ( -f $file ) { $self->errmsg("$profile\'s file ($file) does not exist for $dist $ver!"); return; }
print STDERR "parse_profile : Draining $file for defaults\n" if $self->debug;
unless (open(IN,$file)) {$self->errmsg("Error opening $file : $!"); return;}
my (@bundles,$rpms,$parts,$final,@coe_bundles,$misc,$patch_me,$patch_freq,$patch_method);
my $bundle_header = $self->bundle_header;
my $rpm_header = $self->rpm_header;
my $part_header = $self->part_header;
my $misc_header = $self->misc_header;
my $final_header = $self->final_header;
my $coe_bundle_header = $self->coe_bundle_header;
my $patch_header = $self->patch_header;
while(<IN>) {
s/
//;
next if /^$part_header/;
last if /^$misc_header/;
$parts .= $_;
}
while(<IN>) {
s/
//;
last if /^$bundle_header/;
$misc .= $_;
}
while(<IN>) {
s/
//;
next if /^%packages/;
last if /^$rpm_header/;
chomp;
s/@\ //;
push(@bundles,$_) if $_;
}
while(<IN>) {
s/
//;
next if /^%post/;
last if /^$final_header/;
$rpms .= $_;
}
while(<IN>) {
s/
//;
last if /$coe_bundle_header/;
$final .= $_;
}
while(<IN>) {
s/
//;
last if /$patch_header/;
chomp;
push(@coe_bundles,$_) if $_;
}
while(<IN>) {
s/
//;
chomp;
if (/^patch_me$/) { $patch_me=1 }
if (/^patch_freq/ ) {
my (@data) = split;
$patch_freq = $data[1];
}
if (/^patch_method/ ) {
my (@data) = split;
$patch_method = $data[1];
}
}
close(IN);
print STDERR "parse_profile : bundles is ".join(',',@bundles)."\n" if $self->debug;
print STDERR "parse_profile : parts is $parts\n" if $self->debug; # McCode ;)
print STDERR "parse_profile : misc is $misc\n" if $self->debug;
print STDERR "parse_profile : coe_bundles is ".join(',',@coe_bundles)."\n" if $self->debug;
return($parts,$misc,$final,$rpms,$patch_me,$patch_freq,\@coe_bundles,\@bundles,$patch_method);
} # End of parse_profile
sub parse_coe_bundles {
# parse COE config file and return an associated array of archs,descriptions, and files(RPMS)
# If called with filename ALL it returns all bundles
my $self = shift;
my ($arch,$dist,$ver,$infile) = @_;
my (%desc,%files,@files);
if ( $infile eq 'ALL' ) {
my @NAMES = split(' ',$defs{'ADDONS'});
foreach my $NAME (@NAMES) {
my @data = $self->parse_addon_config($NAME);
push(@files,shift(@data));
}
} else {
@files = $infile;
}
my $hit = 0;
foreach my $infile (@files) {
print STDERR "parse_coe_bundles($arch,$dist,$ver) -> $infile\n" if $self->debug;
next unless (open(IN,"$infile"));
while(<IN>) {
chomp;
next if /^#/;
next unless $_;
my @data = split(' : ',$_);
my $bundle = shift(@data);
my $distin = shift(@data);
my $verin = shift(@data);
my $archin = shift(@data);
if ( (( $archin eq $arch ) || ( $archin eq 'noarch' )) &&
(( $distin eq $dist ) || ( $distin eq 'nodist' )) &&
(( $verin eq $ver ) || ( $verin eq 'nover' )) ) {
#next if (( $dist eq 'Debian' ) && ( $distin eq 'nodist' ));
$data[1] =~ tr/ //;
$hit++;
my @files = split(',',$data[1]);
my $filelist = join(' ',@files);
if ( $filelist ) {
$desc{$bundle} = "$distin/$verin/$archin/$data[0]";
$files{$bundle} = "$archin $filelist";
print STDERR "SUCCESS: Display $bundle\n" if $self->debug;
}
}
}
}
return(\%desc ,\%files, $hit);
} # End of parse_coe_bundles
sub validate_parts {
# This is just a stub - future if we want to validate the partion table
return(1);
}
sub Store_It {
# Write the profile to disk
my (@coe_bundles,@bundles);
my ($self,$profile,$arch,$distro,$ver,$parts,$misc,$final,$rpms,$patch_me,$patch_freq,$c,$b,$patch_method) = @_;
shift(@_);
#print STDERR join(',',@_)."\n";
@coe_bundles = @{$c};
@bundles = @{$b};
my $filename = $self->get_filename($distro,$ver,$arch,$profile);
my $outfile = $self->profbase . "/$filename";
print STDERR "Store_It : Creating ${outfile}.new!\n" if $self->debug;
if (!open(PROF,">${outfile}.new")) {
$self->errmsg("Error opening $outfile for writing : $!\n");
return;
}
$parts =~ s/^M//g;
$rpms =~ s/^M//g;
$final =~ s/^M//g;
print PROF $self->part_header;
print PROF "\n$parts\n";
print PROF $self->misc_header;
print PROF "\n$misc\n";
print PROF $self->bundle_header;
if ( @bundles ) {
print PROF "\n@ ",join("\n@ ",@bundles),"\n";
}
print PROF $self->rpm_header;
if ( $distro eq 'RedHat' ) {
print PROF "\n$rpms\n%post\n";
} else {
print PROF "\n$rpms\n";
}
print PROF $self->final_header;
print PROF "\n$final\n";
print PROF $self->coe_bundle_header;
print PROF "\n",join("\n",@coe_bundles),"\n";
print PROF $self->patch_header;
if ( $patch_me ) { print PROF "patch_me\n" }
print PROF "patch_freq $patch_freq\n";
print PROF "patch_method $patch_method\n";
close(PROF);
return($filename);
}
###########################
# HTML STUFF
##########################
sub clean_var {
# TEMP - move to CGI::validate next pass
my ($self,$var) = @_;
my $lag = $var;
$var =~ tr/\///d; # drop /'s to prevent directory transversal
$var =~ s/\.\.//g; # drop ..'s to prevent directory transversal
$var =~ tr/\>/>/; # translate xss char
$var =~ tr/\</</;
$var =~ tr/#/#/;
$var =~ tr/&/&/;
$var =~ tr/(/(/;
$var =~ tr/)/)/;
if ( $var ne $lag ) {
print STDERR "clean_var -> cleansed $lag to $var\n" if $self->debug;
}
return($var);
}
sub ShowFooter {
# Wrap the bottom of the theme around SysDes
my $self = shift;
my @nav = "";
if ( $self->nonav ) {
print $q->end_html;
return;
}
return if $self->didbot;
# Open the theme dir
my $themedir = $defs{'COETHEME'};
opendir(DIR,"$themedir");
my @navfiles = sort(readdir(DIR));
closedir(DIR);
# For each header file, spit it out
foreach my $infile (@navfiles) {
next unless ( $infile =~ /^footer/ );
next if ( $infile =~ /~$/ ); # Help our our emacs users
if ( ! open(NAV, "$themedir/$infile") ) {
print STDERR "Internal error: Couldn't open html navigation ($infile).\n";
return;
}
@nav = <NAV>;
print qq[@nav];
close NAV;
}
$self->didbot(1);
} # End ShowFooter
sub ShowNav {
# Wrap the top of the theme around SysDes
my $self = shift;
my $title = shift;
return if $self->didtop;
if ( $self->nonav ) {
print $q->start_html($title);
return;
} else {
print $q->start_html(-title=>$title,
-meta=>{'LinuxCOE'=>'default',
'keywords'=>'Linux hpcoe linux linuxcoe
kernel install
documentation tux scratch monkey'},
-BGCOLOR=>'white');
}
my @nav = "";
# Open the theme dir
my $themedir = $defs{'COETHEME'};
opendir(DIR,"$themedir");
my @navfiles = sort(readdir(DIR));
closedir(DIR);
# For each header file, spit it out
foreach my $infile (@navfiles) {
next unless ( $infile =~ /^header/ );
next if ( $infile =~ /~$/ ); # help our our emacs users
if ( ! open(NAV, "$themedir/$infile") ) {
print STDERR "Internal error: Couldn't open html navigation ($infile).\n";
return;
}
@nav = <NAV>;
print qq[@nav];
close NAV;
}
$self->didtop(1); # Don't do it twice...
} # End ShowNav
sub Display_RPMS {
# Dump a TEXTAREA of selected individual RPM's
my $self = shift;
my ($os,$arch,$rpms,$label) = @_;
return if (( $os =~ /Debian 3.1/ ) || ( $os =~ /Dapper/ ));
if (( $os =~ /Debian/ ) || ( $os =~ /buntu/ )) {
$label = "debs";
} else {
$label = "RPMs";
}
print " Individual $os $label:<br>\n";
print qq[ e.g. "openssh", not "openssh-2.1-i386.rpm||deb"<br>];
print qq[ <font face=monospace size=3>\n];
print qq[<TEXTAREA NAME="rpms" ROWS=10 COLS=20>$rpms</TEXTAREA>];
print qq[</font>];
} # End of Display_RPMS
sub Show_Ks_Help {
# Display a link to more advanced help if available
my $self = shift;
my ($os,$arch) = @_;
my ($indist,$inver) = split(' ',$os);
my ($testver,$bogus) = split('-',$inver); # Drop SP/U level
my $helpfile = $self->find_file("data/config_help.map");
unless (open(HELP,$helpfile)) {
print STDERR "LinuxCOE.pm -> Show_Ks_Help - couldn't find data/config_help.map!!!!\n";
print "No Help available at present\n<BR>";
return;
}
my %helpurls;
while(<HELP>) {
chomp;
next if /^#/;
my ($dist,$ver,$url) = split;
next unless ($dist);
$helpurls{"$dist $ver"} = $url;
}
close(HELP);
my $help = $helpurls{"$indist $testver"};
if ($help) {
print "<A HREF=$help>$os Support</A>\n<BR>";
} else {
print "No Help available at present\n<BR>";
}
}
sub Display_Misc_Box {
# Dump a TEXTAREA of the current misc kickstart info
my $self = shift;
my ($os,$arch,$misc) = @_;
print "<H3>Misc Kickstart Options</H3>\n";
print "Here's full access to the rest of the kickstart commands.<br>\n";
print "<P>For more information regarding these options , see the documentation at ";
$self->Show_Ks_Help($os,$arch);
print qq[<TEXTAREA NAME="misc" ROWS=20 COLS=80>$misc</TEXTAREA>];
print qq[</font>];
} # End of Display_Misc_Box
sub Display_Disk_Partition {
# Dump a TEXTAREA of the current disk partition info
my $self = shift;
my ($os,$arch,$parts) = @_;
print "<H3>Partition your hard drive</H3>\n";
print "These commands will determine how your hard drive is laid out.<br>\n";
print "<P>For more information regarding disk partitioning options , see the documentation at ";
$self->Show_Ks_Help($os,$arch);
my ( $dist,$ver ) = split(' ',$os);
if ( $dist eq 'RedHat' ) {
print "Look for topics: <UL>";
if ( $ver ge '7.2' ) { print "<LI>bootloader" }
print "<LI>clearpart<LI>lilo<LI>part<LI>zerombr</UL><BR>\n<font face=monotype>";
}
print qq[<TEXTAREA NAME="parts" ROWS=20 COLS=80>$parts</TEXTAREA>];
print qq[</font>];
} # End of Display_Disk_Partition
sub Display_Final {
# Display the final script in a TEXTAREA
my $self = shift;
my $os = shift;
my $arch = shift;
my $installer = 'rpm';
if ( $os =~ /Debian/ ) { $installer = 'dpkg' }
my $final = shift;
print "<H3>Final Script</H3>\n";
print "<P>This code will be executed in a chroot environment after the system is installed but before the final reboot.
If you have custom packages on another server, this is the place to install them ($installer -i <URL>).</P>\n";
print "<P>For more information regarding the post processing environment, see the documentation at ";
$self->Show_Ks_Help($os,$arch);
if ( $os =~ /RedHat/ ) {
print "Look for topic: <i>%post -- Post-Installation Configuration Section</i></P>\n";
print qq[<font face=monotype>];
}
print qq[<TEXTAREA NAME="final" ROWS=10 COLS=80>$final</TEXTAREA>];
print qq[</font><br><p>\n];
} # End of Display_Final
sub Display_COE_Bundles {
# Return a checkbox'ed list of valid LinuxCOE bundles
my $self = shift;
my ($os,$arch,$b,$NAME) = @_;
my @coe_bundles;
if ($b) {
@coe_bundles = @{$b};
}
my (%desc,%files);
my ($dist,$ver) = split(' ',$os);
return if ( $dist eq 'VMWare' );
my ($config,$helpurl,$rpmapt,$debapt,$rpmyum,@needs) = $self->parse_addon_config($NAME);
my ($d,$f) = $self->parse_coe_bundles($arch,$dist,$ver,$config);
foreach my $needit (@needs) {
unless ( defined(${$d}{$needit}) ) {
${$d}{$needit} = "BOGUS"; # Mark a selection to grey out
print STDERR "Marking \"$needit\" as a requirement!\n" if $self->debug;
}
}
if ( keys(%{$d}) ) {
print "<h3>Select $NAME bundles:</h3>";
print "<p>Click on bundle name for full description.</p>\n";
print "<TABLE BORDER=0>\n";
foreach my $bundle (sort(keys(%{$d}))) {
print "<TR>";
my $test = $bundle;
$test =~ s/\(/\\\(/g;
$test =~ s/\)/\\\)/g;
$test =~ s/\+/\\\+/g;
my @files = split(' ',${$f}{$bundle});
my $arch = shift(@files);
if ( ${$d}{$bundle} eq 'BOGUS' ) {
#print qq[<TD>N/A</TD><TD><font color=#888888> $bundle - <i>Not yet available for $os</i><font></TD>\n];
print qq[<TD><INPUT TYPE="checkbox" disabled="disabled"></TD><TD><font color=#888888> $bundle - <i>Not yet available for $os</i><font></TD>\n];
} else {
print "<TD>";
if ( grep(/^$test$/,@coe_bundles) == 1 ) {
print qq[<INPUT TYPE="checkbox" NAME="coe_bundles" VALUE="$bundle" CHECKED></TD>];
} else {
print qq[<INPUT TYPE="checkbox" NAME="coe_bundles" VALUE="$bundle"></TD>];
}
print qq[<TD> <A TARGET="help" HREF="$helpurl/${$d}{$bundle}">$bundle</A></TD>\n];
}
print "</TR>";
}
print "</TABLE>\n";
print "</P>\n";
}
} # End of Display_COE_Bundles
sub Display_Bundles {
# Display Valid 'Bundles' - checking the ones you've already picked
my $self = shift;
my ($os,$arch,$b,$base) = @_;
my @bundles;
if ( $b ) { @bundles = @{$b} }
my @valid_bundles = $self->valid_entries($os,$arch,'bundles');
my $descr = 0;
$os =~ s/ /-/;
# SuSE needs ONE <base></base> tag
# BASE: default
# ADDON: Base-System
print STDERR "Display_bundles passed base eq $base\n" if $self->debug;
if ( $os =~ /SuSE/ ) {
my @bundles = @valid_bundles;
@valid_bundles = ();
print qq[Select <b>one $os base</b> software bundle:</a><BR>\n];
print "<TABLE>\n";
foreach my $bundle (sort(@bundles)) {
if ( $bundle =~ /^BASE: / ) {
$bundle =~ s/BASE: //;
print STDERR "looking for bundle $bundle in \@bundles or $bundle eq $base\n" if $self->debug;
if (( grep(/^$bundle$/,@{$b}) ) || ( $bundle eq $base )) {
print qq[ <TR><TD><input TYPE="radio" NAME="base" VALUE="$bundle" CHECKED><a href="/@PACKAGE_NAME@/bundles/${os}.html#$bundle" target="help">$bundle</a></TD></TR>\n];
} else {
print qq[ <TR><TD><input TYPE="radio" NAME="base" VALUE="$bundle"><a href="/@PACKAGE_NAME@/bundles/${os}.html#$bundle" target="help">$bundle</a></TD></TR>\n];
}
} else {
$bundle =~ s/ADDON: //;
push(@valid_bundles,$bundle);
}
}
print "</TABLE><P></P>\n";
}
if ( $os =~ /Ubuntu/ ) {
my @bundles = @valid_bundles;
@valid_bundles = ();
return unless (@bundles);
print qq[Select <b>one $os</b> base install:</a><BR>\n];
print "<TABLE>\n";
foreach my $bundle (sort(@bundles)) {
print STDERR "looking for bundle $bundle in \@bundles or $bundle eq $base\n" if $self->debug;
if ( grep(/^$bundle$/,@{$b}) ) {
print qq[ <TR><TD><input TYPE="radio" NAME="bundles" VALUE="$bundle" CHECKED><a href="/@PACKAGE_NAME@/bundles/${os}.html#$bundle" target="help">$bundle</a></TD></TR>\n];
} else {
print qq[ <TR><TD><input TYPE="radio" NAME="bundles" VALUE="$bundle"><a href="/@PACKAGE_NAME@/bundles/${os}.html#$bundle" target="help">$bundle</a></TD></TR>\n];
}
}
print "</TABLE>";
return;
}
if ( -f "$OPT/html/bundles/${os}.html" ) {
$descr = 1;
print qq[Select <a href=/@PACKAGE_NAME@/bundles/${os}.html target="help">$os software bundles:</a><BR>];
} else {
print "Select $os software bundles: <BR>";
}
my $boxes = "document.form.bundles";
print "<P><input type=button value=\"Select All\" onClick=\"checkem($boxes,1)\">\n";
print "<input type=button value=\"Unselect All\" onClick=\"checkem($boxes,0)\">\n";
print "<input type=button value=\"Invert Selections\" onClick=\"invertAll($boxes)\"></P>\n";
print STDERR "Diplay_Bundles: @bundles\n" if $self->debug;
my $count = @valid_bundles;
#$descr = 1;
# If there's > 16, do a 2 column table, otherwise just list 'em...
if ( $count > 16 ) {
my $half = int($count/2);
if ( $count % 2 ) {
$half++;
}
print "<TABLE>";
foreach my $i (0 .. $half-1) {
print "<TR><TD>";
my $test = $valid_bundles[$i];
my $url;
if ( $descr ) {
# <a href="#Summary">E
$url = qq[<a href="/@PACKAGE_NAME@/bundles/${os}.html#$valid_bundles[$i]" target="help">$test</a>];
}
$url = $url || $test;
$test =~ s/\+/\\\+/;
if ( grep(/^$test$/,@{$b}) == 1 ) {
print qq[<INPUT TYPE="checkbox" NAME="bundles" VALUE="$test" CHECKED> $url\n];
} else {
print qq[<INPUT TYPE="checkbox" NAME="bundles" VALUE="$test"> $url\n];
}
print "</TD><TD>";
$test = $valid_bundles[$i+$half];
undef($url);
if ( $descr ) {
$url = qq[<a href="/@PACKAGE_NAME@/bundles/${os}.html#$valid_bundles[$i+$half]" target="help">$test</a>];
}
$url = $url || $test;
if ( $test ) {
if ( grep(/^$test$/,@{$b}) == 1 ) {
print qq[<INPUT TYPE="checkbox" NAME="bundles" VALUE="$test" CHECKED> $url\n];
} else {
print qq[<INPUT TYPE="checkbox" NAME="bundles" VALUE="$test"> $url\n];
}
} else {
print "<BR>";
}
print "</TD></TR>\n";
}
print "</TABLE>";
} else {
foreach my $test (@valid_bundles) {
my $url;
if ( $descr ) {
$url = qq[<a href=/@PACKAGE_NAME@/bundles/${os}.html#$test target="help">$test</a>];
}
$url = $url || $test;
if ( grep(/^$test$/,@{$b}) == 1 ) {
print qq[<INPUT TYPE="checkbox" NAME="bundles" VALUE="$test" CHECKED> $url<br>\n];
} else {
print qq[<INPUT TYPE="checkbox" NAME="bundles" VALUE="$test"> $url <br>\n];
}
}
}
}
sub Create_Final_HTML {
# The image/config files are created, gen a page of HTML to return to caller with
# variable substituted. Caller will deal with whether theme/etc. is in place.
my ($self,$distro,$ver,$arch,$installer,$image_type,$sec_level,$htmlpath,$custimg,$serial,%sr_array) = @_;
# Let look for the dist-ver-arch tuple, if exists, is that, else try arch, else simply use
# a standard of $installer(KS|YAST|PRESEED|AUTOINST|SIM)-image_type
if ( $self->def('SIM') ) {
$installer = 'SIM';
$image_type = 'SIM';
my $simpath = $self->def('SIM');
$simpath .= "/$serial";
$sr_array{'SIMPATH'} = $simpath;
}
print STDERR "Looking for html/desginer/final-$distro-$ver-$arch-$image_type.html\n" if $self->debug;
my $infile = $self->find_file("html/final-$distro-$ver-$arch-$image_type.html");
unless ( $infile ) {
print STDERR "Looking for html/final-$installer-$arch-$image_type.html\n" if $self->debug;
$infile = $self->find_file("html/final-$installer-$arch-$image_type.html");
}
unless ( $infile ) {
print STDERR "Looking for html/final-$installer-$image_type.html\n" if $self->debug;
$infile = $self->find_file("html/final-$installer-$image_type.html");
}
print STDERR "Create_Final_HTML: Using $infile for final_html template!\n" if $self->debug;
return(undef) unless ($infile);
open(IN,"$infile");
local $/;
my $final_html = <IN>; # Slurp the file into a string
close(IN);
# Here's the 'automatic sub/replace'
$sr_array{'DISTRO'} = $distro;
$sr_array{'OSVER'} = $ver;
$sr_array{'ARCH'} = $arch;
$sr_array{'METHOD'} = $defs{'FINAL_URL_METHOD'} || 'ftp://';
$sr_array{'PATH'} = $defs{'FINAL_URL_PATH'} || '/pub/LinuxCOE/images';
# Calculate the MD5SUM on the file
if (( $self->def('SHOW_MD5SUM') ) && ( -r "$custimg" )) {
use Digest::MD5;
my $ctx = Digest::MD5->new;
open(MD5FILE,$custimg);
$ctx->addfile(*MD5FILE);
my $digest = $ctx->hexdigest;
close(MD5FILE);
my @data = split('/',$custimg);
my $fname = pop(@data);
$sr_array{'MD5SUM'} = "<tr><td colspan=2>MD5SUM : <pre>$digest $fname</pre></td></tr>";
} else {
$sr_array{'MD5SUM'} = ''; # Drop it if not needed
}
# If we're in secure mode, great a random user/passwd and a .htaccess file for control
if ( $sec_level eq 'SECURE' ) {
my $user = $self->random_string(8);
my $pass = $self->random_string(8);
print STDERR "Secure final, username $user, password $pass\n" if $self->debug;
open(OUT,">$htmlpath/.htaccess") || die "Cannot open $htmlpath/.htaccess : $!\n";
print OUT "AuthType Basic\n";
print OUT "AuthUserFile $htmlpath/.htpasswd\n";
print OUT qq[AuthName "Password Required"\n];
print OUT "Require valid-user\n";
close(OUT);
open(OUT,">$htmlpath/.htpasswd") || die "Cannot open $htmlpath/.htpasswd : $!\n";
my @seeds = ('A'..'Z','a'..'z');
my $seed = $seeds[int(rand(52))] . $seeds[int(rand(52))];
my $enc_pass = crypt($pass,$seed);
print OUT "$user:$enc_pass\n";
close(OUT);
$sr_array{'COE_WAYSTATION'} = "$user:$pass\@" . $sr_array{'COE_WAYSTATION'};
}
# Do it
foreach my $old (keys(%sr_array)) {
my $new = $sr_array{$old};
$final_html =~ s/\@$old\@/$new/g;
}
return($final_html);
}
###################
# Default Stuff
###################
sub make_default_parts {
my ($self,$os,$arch) = @_;
my ($distro,$ver) = split(' ',$os);
# Define a default disk partition scheme
my $parts;
my $infile = $self->find_file("data/parts-$distro-$ver-$arch");
unless ($infile) { $infile = $self->find_file("data/parts-$distro-$ver") }
unless ($infile) { $infile = $self->find_file("data/parts-$distro") }
print STDERR "Draining $infile for default partitions\n" if $self->debug;
if ( -r "$infile" ) {
open(IN,"$infile");
while(<IN>) { $parts .= $_ }
close(IN);
} else {
$parts .= "# Unknown os $os! Send email to leem\@atl.hp.com!\n";
}
return($parts);
} # End of make_default_parts
sub make_default_misc {
my ($self,$os,$arch) = @_;
my ($distro,$ver) = split(' ',$os);
my $file = join('-','misc',$distro,$ver,$arch);
# Define a default disk partition scheme
my $misc;
my $infile = $self->find_file("data/misc-$distro-$ver-$arch");
unless ($infile) { $infile = $self->find_file("data/misc-$distro-$ver") }
unless ($infile) { $infile = $self->find_file("data/misc-$distro") }
print STDERR "Draining $infile for default partitions\n" if $self->debug;
if ( -r "$infile" ) {
open(IN,"$infile");
while(<IN>) { $misc .= $_ }
close(IN);
} else {
$misc .= "# Unknown os $os! Send email to leem\@atl.hp.com!\n";
}
return($misc);
} # End of make_default_misc
sub make_default_final {
# Just a stub, may need in the future
my $self = shift;
my $os = shift;
my $final;
return($final);
} # End of make_default_final
sub LoadDefs {
# Drain the defaults file.
my $self = shift;
my $file = shift;
my $drain_dir=0; # If this is first pass, honor include dir
$drain_dir = 1 unless ($file); # Initial invocation is the only time $file should be unset
if ( $file ) {
$file = $self->clean_var($file); # Don't trust user input
$file = $self->find_file($file); # If it exists, look for it
} else {
$file = $self->deffile; # If no defs passed, parse default defined at top
}
print STDERR "LoadDefs Looking for $file\n" if $self->debug;
$self->parse_def("$file") if ( -r "$file" );
if ($drain_dir) {
if ($defs{'INCLUDE_DIR'}) { # They said search here too for more init info
my $dir = $defs{'INCLUDE_DIR'};
print STDERR "Looking in $dir for more init info...\n" if $self->debug;
opendir(DIR,$dir) || last ; # Nothing to see here, move along
my @incs = sort(readdir(DIR));
foreach my $file (@incs) {
$self->parse_def("$dir/$file") if ( -r "$dir/$file" );
}
}
}
# Look for osvend.d/files in $OPT, $ETC, and ALT_DATA. Last wins since it's a %hash
my @dirs = ($OPT,$ETC,$defs{'ALT_DATA'});
foreach my $osdir (@dirs) {
next unless ( -d "$osdir/osvend.d" );
unless (opendir(DIR,"$osdir/osvend.d")) {
print STDERR "Failed to opendir($osdir/osvend.d) : $!\n";
next;
}
my @files = sort(readdir(DIR));
closedir(DIR);
shift(@files); shift(@files); # Drop . & ..
foreach my $file (@files) { $self->parse_def("$osdir/osvend.d/$file") if ( -r "$osdir/osvend.d/$file" ) }
}
}
sub parse_def {
# Open the file, parse it for VAR == VAL, populate %defs array
my ($self,$file) = @_;
print STDERR "parse_def: Loading defaults from $file\n" if $self->debug;
open(IN,"$file") || die "Cannot open $file : $!\n";
while(<IN>) {
next if (/^#/);
chomp;
next unless $_;
my ($tag,@data) = split;
if ( $tag eq 'OSVEND') {
my ($way,$dist,$ver,$arch,$method,$path) = @data;
$OSVEND{"$dist:$ver:$arch:$method:$way"} = "$path";
print STDERR "LoadDefs: \$OSVEND{\"$dist:$ver:$arch:$method:$way\"} = $path\n" if $self->debug;
} else {
$defs{$tag} = join(' ',@data);
print STDERR "LoadDefs: \$defs{$tag} = $defs{$tag}\n" if $self->debug;
}
}
close(IN);
}
sub def {
# if set, do it, if not, just hurl the entry back, if any.
my ($self,$tag,$val) = @_;
if ( $val ) {
$defs{$tag} = $val;
} else {
return($defs{$tag});
}
}
sub get_defzone {
# If set in config file, return it
# If ip of client is resolvable, return that
# If ip of web broser is resovlable, return that
# return PST8PDT
my $self = shift;
my ($hostname,$distro) = @_;
my $tzfile = $self->find_file('data/tz_data');
my %tzs;
# If we have a list mapping domains to default TZ, snag it.
if ($tzfile) {
open(TZ,$tzfile);
while(<TZ>) {
chomp;
my ($dom,$tz) = split;
$tzs{$dom} = $tz;
}
close(TZ);
}
if ( $hostname ) {
my @parts = split('\.',$hostname);
shift(@parts);
my $domain = join('.',@parts);
print STDERR "Doing hostname domain $domain!\n" if $self->debug;
if ( $tzs{$domain} ) { return($tzs{$domain}) }
}
if ( $ENV{'REMOTE_ADDR'} ) {
my ($hostname,$ip) = &do_dns($ENV{'REMOTE_ADDR'});
my @parts = split('\.',$hostname);
shift(@parts);
my $domain = join('.',@parts);
print STDERR "Doing browser $hostname domain $domain!\n" if $self->debug;
if ( $tzs{$domain} ) { return($tzs{$domain}) }
}
if ( $self->def('TZ') ) { return($self->def('TZ')) }
return("US/Pacific"); # When all else fails...
}
sub make_mortal_user {
my $self = shift;
my ($uname,$gecos,$passwd,$deb_flag) = @_;
my @seeds = ('A'..'Z','a'..'z');
my $seed = $seeds[int(rand(52))] . $seeds[int(rand(52))];
my $enc_pass = crypt($passwd,$seed);
$gecos = $gecos || "LinuxCOE User";
if ( $deb_flag ) {
return("/usr/sbin/groupadd $uname\n/usr/sbin/useradd -m -g $uname -c \"$gecos\" -p $enc_pass $uname\n");
} else {
return("/usr/sbin/useradd -m -c \"$gecos\" -p $enc_pass $uname\n");
}
}
sub end_it_now {
# Exit with extreme predjudice
my ($self,$errmsg) = @_;
my $header = $self->err_msg;
$self->ShowNav($header);
print $q->h4("$errmsg");
my $admin = $defs{'SITE_ADMIN'};
$errmsg .= "<hr>If this error message looks bogus, contact <a href=\"mailto:$admin>$admin</a>\n" if $admin;
print $q->end_html;
$self->ShowFooter;
exit;
}
sub err_msg {
my $self = shift;
my $header = 'SysDes Error!';
my $errfile = $self->find_file("includes/errors");
if ( open(ERR,"$errfile") ) {
my @data;
while(<ERR>) {
chomp;
next if /^#/;
next unless $_;
push(@data,$_);
}
close(ERR);
my $count = @data;
my $pick=int(rand($count));
$header = $data[$pick] if $data[$pick];
}
return($header);
}
sub valid_entries {
# Pull a list of valid entries distro/rev/arch
# This was originally in MySQL tables, so the kode is kinda hokey...
my ($self,$os,$arch,$what,$match) = @_;
my ($dist,$ver) = split(' ',$os);
my $infile = $self->find_file("data/$what-$dist-$ver-$arch");
unless ($infile) { $infile = $self->find_file("data/$what-$dist-$ver") }
unless ($infile) { $infile = $self->find_file("data/$what-$dist") }
unless ( -f $infile ) { # RALPH! There are NO bundles registered. Something went terribly wrong...
$self->errmsg("Major Malfunction!<P>I found no $what for $dist $ver $arch!!!<P>Probable database corruption!");
return;
}
print STDERR "valid_entries: parsing $infile\n" if $self->debug;
unless ( open(IN,$infile) ) {
$self->errmsg("Major Malfunction!<P>Error opening $infile for reading : $!\n");
return;
}
if (( $what ne 'langs' ) && ( $what ne 'images' ) && ( ! $match ) &&
( $what ne 'mouses' ) && ( $what ne 'kbds' )) {
my @entries;
while(<IN>) {
chomp;
next unless ($_);
next if /^#/;
push(@entries,$_);
}
close(IN);
return(sort(@entries));
} elsif ( $match ) {
my @entries;
while(<IN>) {
chomp;
next unless ($_);
next if /^#/;
my ($key,$value) = split;
if ( $key eq $match ) {
if ( $os =~ /Deb/ ) {
push(@entries,$value)
} else {
push(@entries,$_)
}
}
}
close(IN);
return(sort(@entries));
} else {
my %entries;
while(<IN>) {
chomp;
next unless ($_);
next if /^#/;
my ($key,@values) = split;
my $label = join(' ',@values);
$entries{$key} = $label || $key;
}
close(IN);
return(%entries);
}
}
sub Check_Me {
# Little JS snippet for bundle checkbox manipulation
print qq[ <script language="javascript">
function checkem(bundles,flag) {
for (var j=0; j < bundles.length; j++) {
bundles[j].checked = flag;
}
}
function invertAll(bundles) {
for (var j=0; j < bundles.length; j++) {
if (bundles[j].checked == true) { bundles[j].checked = false;}
else { bundles[j].checked = true; }
}
}
</script>
];
}
sub check_passwd {
# Check password provided with password in the database
my ($self,$profile,$distro,$ver,$passwd,$arch) = @_;
# $DB{"$dist:$ver:$arch:$profile"} = "$owner $passwd $filename";
my $key = "$distro:$ver:$arch:$profile";
my ($owner,$realpass,$filename) = split(' ',$DB{$key});
if ( $passwd ne $realpass ) {
$self->errmsg($owner);
return;
} else {
return(1);
}
}
sub sortic { uc($a) cmp uc($b) }
sub show_profiles {
# Generate a list of valid profiles for this OS
my $self = shift;
my ($dist,$ver,$arch) = @_;
my @profiles;
foreach my $key (sort(keys(%DB))) {
next unless ( $key =~ /^$dist:$ver:$arch/ );
my ($dist,$stuff,$ver,@profile) = split(':',$key);
my $profile = join(':',@profile);
print STDERR "Found profile $profile for $dist $ver $arch\n" if $self->debug;
push(@profiles,$profile);
}
return(sort sortic(@profiles));
}
sub profile_details {
# return owner/passwd/filename for profile
my ($self,$dist,$ver,$arch,$profile) = @_;
my ($owner,$passwd,$file) = split(' ',$DB{"$dist:$ver:$arch:$profile"});
return($owner,$passwd,$file);
}
sub delete_profile {
my ($self,$dist,$ver,$arch,$profile) = @_;
delete($DB{"$dist:$ver:$arch:$profile"});
}
sub add_profile {
my ($self,$dist,$ver,$arch,$profile,$owner,$passwd,$filename) = @_;
$DB{"$dist:$ver:$arch:$profile"} = "$owner $passwd $filename";
}
sub Show_Patch {
# $db->Show_Patch($distro,$version,$patch_me,$patch_freq);
my ($self,$distro,$version,$patch_me,$patch_freq,$arch,$patch_method) = @_;
return if (($distro eq 'VMWare') || ( $distro eq 'Debian' ) || ( $distro =~ /buntu/ ));
print $q->h3("Select Patching Options");
my ($checked,$freq);
if ($patch_me) { $checked = ' CHECKED' }
print qq[<INPUT TYPE="CHECKBOX" NAME="patch_me" VALUE="YES" $checked> - Apply all current $distro patches during install
<P>and also automatically apply new $distro patches:
<SELECT NAME="patch_freq">
];
my @options = qw(never daily weekly monthly);
foreach my $opt (@options) {
if ( $opt eq $patch_freq ) {
print "<OPTION SELECTED>$opt\n";
} else {
print "<OPTION>$opt\n";
}
}
print "</SELECT></P>\n";
return if (( $distro eq 'Debian' ) || ( $distro =~ /buntu/ ));
print "<P>Desired patching method:";
# Slurp in our patching choices
my $patchfile = $self->find_file("data/patch_methods.map");
open(PATCHES,$patchfile); # too deep in HTML to die here, fail silently
my (%options,%labels);
while(<PATCHES>) {
#SuSE 9.3 x86_64 YUM YOU
#LABEL: APT Advanced Package Tool
chomp;
next if /^#/;
my ($dist,@rest) = split;
next unless ($dist);
if ( $dist eq 'LABEL:' ) {
my $lab = shift(@rest);
$labels{$lab} = join(' ',@rest);
} else {
my $ver = shift(@rest);
my $arch = shift(@rest);
$options{"$dist $ver $arch"} = join(' ',@rest);
}
}
close(PATCHES);
# Present the user with a pulldown
my ($testver,@rest) = split('-',$version); # Drop -SP#/-U#
print qq[<SELECT NAME="patch_method">];
my @meths = split(' ',$options{"$distro $testver $arch"});
foreach my $meth (@meths) {
if ( $meth eq $patch_method ) {
print qq[<OPTION VALUE="$meth" SELECTED>$meth - $labels{$meth}\n];
} else {
print qq[<OPTION VALUE="$meth">$meth - $labels{$meth}\n];
}
}
print "</SELECT></P>\n";
}
sub network_bcast {
my ($self,$ip,$nm) = @_;
my (@nw,@bc) ;
my @ips = split('\.',$ip);
my @nms = split('\.',$nm);
# Determine subnet/broadcast
for my $i ( 0..3 ) {
$nw[$i] = (0+$ips[$i]) & (0+$nms[$i]); # subnet is ip AND'ed with netmask
$bc[$i] = ($ips[$i] | (~ $nms[$i])) & 255; # broadcast is ip OR'ed with inverse of netmask
}
my $nw = join('.',@nw);
my $bc = join('.',@bc);
return($nw,$bc);
}
sub Store_Conf {
# This is a special, unused for most
my ($self,$ks_file,$asset) = @_;
my $path = $defs{'ASSET_PATH'};
if ( $defs{'SHOW_ASSET'} ) {
# If this fails, ignore it
system "/bin/cp $ks_file $path/$asset.txt";
}
}
sub parse_addon_config {
my ($self,$infile,$disto,$ver,$arch) = @_;
my $addonfile = $self->find_file("addons/$infile");
open(ADDON,"$addonfile") || return;
my (@needs,$helpurl,$config,$rpmapt,$debapt,$rpmyum);
while(<ADDON>) {
next if /^#/;
chomp;
next unless $_;
my ($tag,@data) = split;
if ( $tag eq 'HELP-URL') {
$helpurl = shift(@data)
} elsif ( $tag eq 'CONFIG') {
$config = shift(@data)
} elsif ( $tag eq 'APT-RPM') {
while (<ADDON>) {
last if /\}/;
$rpmapt .= $_;
}
} elsif ( $tag eq 'APT-DEB') {
while (<ADDON>) {
last if /\}/;
$debapt .= $_;
}
} elsif ( $tag eq 'DEFAULT-BUNDLES') {
while (<ADDON>) {
last if /\}/;
chomp;
push(@needs,$_);
}
} elsif ( $tag eq 'YUM-RPM') {
while (<ADDON>) {
last if /\}/;
$rpmyum .= $_;
}
}
}
close(ADDON);
print STDERR "Returning \$rpmapt of $rpmapt" if $self->debug;
return($config,$helpurl,$rpmapt,$debapt,$rpmyum,@needs);
}
sub boot_lipstick {
# put the common LinuxCOE boot time look-n-feel/lipstick on the image
my ($self,$realdir,$distro,$version,$arch,$waystation,$method,$profile,$ip,$nm,$gw,$ns,$final_text,$parts,$msgtail,$interface,$hostname,$kbd,$mouse,$lang,$timezone,$b,$c,$indefs) = @_;
use binaries;
if ( $distro eq 'SuSE' ) { $msgtail = "0c[F1-Main] [F6-Local] [F7-Disk] [F8-SuSE] [F9-COE] [F10-Final]07\n"; }
print STDERR "Inserting custom syslinux.cfg and boot.msg file onto floppy\n" if $self->debug;
my $COE_NAME = $defs{'COE_NAME'};
my $infile = $self->find_file("boot/boot.msg");
# For IA64, let's default to simple/text @ elilo time, often cereal console.
if ($arch eq 'ia64') { $infile = $self->find_file("boot/boot_ia64.msg") }
open(IN,"$infile");
open(OUT,">$realdir/boot.msg");
my $datestr = localtime;
while(<IN>) {
s/COE_VER/$COE_VER/g;
s/COE_NAME/$COE_NAME/;
s/RH_VER/$distro $version/g;
if ( $indefs ) {
s/COE_PROFILE/$profile ($indefs) on $datestr/g;
} else {
s/COE_PROFILE/$profile on $datestr/g;
}
s/WAYSTATION/$waystation ($method)/;
if (( /manual rescue/ ) && ($distro eq 'Debian' )) {
<IN>;
if ( $version eq '3.1' ) {
print OUT "0cinstall2607 Perform the install using a 2.6 kernel\n\n" if ( $arch ne 'x86_64' );
} else {
if ($version =~ /Etch/ ) {
print OUT "0c2.4 kernel autoinstalls currently unsupported by SystemDesigner\n\n";
} else {
print OUT "0cinstall2407 Perform the install using a 2.4 kernel\n\n" if ( $arch ne 'x86_64' );
}
}
next;
} elsif (( /manual rescue/ ) && (($distro =~ /buntu/ ) || $distro =~ /Mandr/ )) {
<IN>;
next;
} elsif (( /manual rescue/ ) && ($distro eq 'SuSE' )) {
s/manual rescue/rescue /;
}
if ( $distro eq 'SuSE' ) {
s/START/F6/;
s/FINISH/F10/;
} else {
s/START/F2/;
s/FINISH/F6/;
}
print OUT;
}
close(IN);
close(OUT);
return if ($arch eq 'ia64');
$infile = $self->find_file("boot/final.msg");
open(IN,"$infile");
open(OUT,">$realdir/final.msg");
$final_text =~ s/^M//g;
$final_text =~ s/\n+/\n/gs;
my @data = split(/\n/, $final_text);
while(<IN>) {
s/COE_VER/$COE_VER/g;
s/COE_NAME/$COE_NAME/;
s/RH_VER/$distro $version/g;
if ( /REAL_DATA_HERE/ ) {
my $count = 0;
while($count < 20) {
print OUT "$data[$count++]\n";
}
} else {
print OUT;
}
}
print OUT $msgtail;
close(OUT);
$infile = $self->find_file("boot/disk.msg");
open(IN,"$infile");
open(OUT,">$realdir/disk.msg");
while(<IN>) {
s/COE_VER/$COE_VER/g;
s/COE_NAME/$COE_NAME/;
s/RH_VER/$distro $version/g;
if ( /REAL_DATA_HERE/ ) {
print OUT "$parts\n";
} else {
print OUT;
}
}
close(IN);
print OUT $msgtail;
close(OUT);
$infile = $self->find_file("boot/network.msg");
open(IN,"$infile");
open(OUT,">$realdir/network.msg");
while(<IN>) {
s/COE_VER/$COE_VER/g;
s/COE_NAME/$COE_NAME/;
s/RH_VER/$distro $version/g;
if ( /REAL_DATA_HERE/ ) {
print OUT "Waystation: $waystation\n";
print OUT "Method: $method\n";
if ( $distro ne 'Debian' ) {
print OUT "Interface: $interface\n";
}
if ( $ip ) {
print OUT "IP Addr: $ip\n";
print OUT "Hostname: $hostname\n";
print OUT "Netmask: $nm\n";
print OUT "NameServer: $ns\n";
print OUT "Gateway: $gw\n";
} else {
print OUT "FULL TIME DHCP!\n\n";
print OUT "You must have a DHCP server on your subnet!!!\n";
}
print OUT "Timezone: $timezone\n";
if ( $distro ne 'Debian' ) {
print OUT "Language: $lang\n";
print OUT "Keyboard: $kbd\n";
print OUT "Mouse: $mouse\n";
} else {
print OUT "\n\n\n";
}
} else {
print OUT;
}
}
close(IN);
print OUT $msgtail;
close(OUT);
my ($b1,$b2);
format OUT =
@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$b1, $b2
.
$infile = $self->find_file("boot/rhbund.msg");
open(IN,"$infile");
open(OUT,">$realdir/rhbund.msg");
while(<IN>) {
s/COE_VER/$COE_VER/g;
s/COE_NAME/$COE_NAME/;
s/RH_VER/$distro $version/g;
if ( /REAL_DATA_HERE/ ) {
while ( $b1 = shift(@{$b}) ) {
$b2 = shift(@{$b});
write OUT;
}
} else {
print OUT;
}
}
close(IN);
print OUT $msgtail;
close(OUT);
$infile = $self->find_file("boot/coebund.msg");
open(IN,"$infile");
open(OUT,">$realdir/coebund.msg");
while(<IN>) {
s/COE_VER/$COE_VER/g;
s/COE_NAME/$COE_NAME/;
s/RH_VER/$distro $version/g;
if ( /REAL_DATA_HERE/ ) {
while ( $b1 = shift(@{$c}) ) {
$b2 = shift(@{$c});
write OUT;
}
} else {
print OUT;
}
}
close(IN);
print OUT $msgtail;
close(OUT);
$infile = $self->find_file("boot/egg.msg");
if ( -f "$infile") {
open(IN,"$infile");
open(OUT,">$realdir/egg.msg");
while(<IN>) {
s/COE_VER/$COE_VER/g;
s/COE_NAME/$COE_NAME/;
print OUT;
}
close(IN);
print OUT "\n$msgtail";
close(OUT);
}
}
sub sw_methods {
# Slurp in our patching choices
my ($self,$distro,$version,$arch) = @_;
my $patchfile = $self->find_file("data/patch_methods.map");
open(PATCHES,$patchfile); # too deep in HTML to die here, fail silently
my (%options,%labels);
while(<PATCHES>) {
#SuSE 9.3 x86_64 YUM YOU
#LABEL: APT Advanced Package Tool
chomp;
next if /^#/;
my ($dist,@rest) = split;
next unless ($dist);
if ( $dist eq 'LABEL:' ) {
my $lab = shift(@rest);
$labels{$lab} = join(' ',@rest);
} else {
my $ver = shift(@rest);
my $arch = shift(@rest);
$options{"$dist $ver $arch"} = join(' ',@rest);
}
}
close(PATCHES);
# Present the user with a pulldown
my ($testver,@rest) = split('-',$version); # Drop -SP#/-U#
my @meths = split(' ',$options{"$distro $testver $arch"});
return(@meths);
}
See more files for this project here