#!/usr/local/bin/perl # # configure.pl - Configure the MiniVend program # # Version 1.0 # Copyright 1996 by Mike Heins # # 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. # This script should be passed the Perl location as an argument, # but there will be a chance to recover #$DEBUG = 1; # Set STDOUT to autoflush $| = 1; $Rerun = 0; my $param; PARAM: { my $param = shift || ''; unless($param =~ /^-/) { $PERL = $param if $param; } elsif ($param eq '-i') { $InstallOnly = 1; } elsif ($param eq '-rerun') { warn "**** Re-running with specified Perl ****\n"; $Rerun = 1; } elsif ($param eq '-D') { warn "**** Setting DEBUG to on ****\n"; $DEBUG = 1; } elsif ($param eq '--' or $param eq '') { # Do nothing } else { warn "Unrecognized parameter $param, ignoring.\a\n" if $param; } last PARAM unless $param; redo PARAM; } # PARAM ############### Configurable Variables ###################### # chop($Initial{'VendRoot'} = `pwd`); $Initial{'HelpFile'} = 'etc/mvconf.cmt'; # ############## END CONFIGURABLE VARIABLES ################### sub is_yes { return( defined($_[0]) && ($_[0] =~ /^[yt1]/i)); } sub is_no { return( !defined($_[0]) || ($_[0] =~ /^[nf0]/i)); } sub do_msg { my ($msg, $size) = @_; $size = 60 unless defined $size; my $len = length $msg; return "$msg.." if ($len + 2) >= $size; $msg .= '.' x ($size - $len); return $msg; } sub cp { my ($srcFile, $dstFile) = @_; my ($buf,$len); open (IN,"<$srcFile") or die "Can't open input $srcFile: $!\n"; open (OUT,">$dstFile") or die "Can't open output $dstFile: $!\n"; my ($access,$mod) = (stat IN)[8,9]; $ = 0; syswrite(OUT, $buf, $len) while $len = sysread(IN, $buf, 8192); $ = 1; close IN; close OUT; utime $access, $mod, $dstFile; } sub regularize { for (@_) { s/[\\]\n//g; s/\n\s+/ /g; s/\s+$//g; } wantarray ? @_ : $_[0]; } sub dontwarn { } sub initconfig { my $file = shift; my($status,$key,$val); open(INITIAL, $file) || return undef; while() { next if /^\s*#/; # Ignore comments next unless /\S/; # Ignore blanks chomp; ($key, $value) = split(/[\t =]+/, $_, 2); $Initial{$key} = $value; } close INITIAL; 1; } sub can_do_suid { my $file = 'mytemp.fil'; my $status; open(TEMPFILE,">$file"); close TEMPFILE; eval { chmod 04755, $file; $@ = ''}; $status = $@ ? 0 : 1; unlink $file; return $status; } sub prompt { my($pr) = shift || '? '; my($def) = shift; my($ans); print $pr; print "[$def] " if $def; chop($ans = ); $ans ? $ans : $def; } sub install_file_lock { mkdir('auto', 0755) or die "mkdir auto/: $!\n"; chdir 'src' or die "Source directory src/ not found: $!\n"; system "tar xf File-Lock-0.9.tar"; chdir 'File-Lock-0.9' or die "chdir: $!\n"; my $makemake = <$file") || die "Couldn't create $file: $!\n"; while() { unless (/^\s*(my\s+)?\$/) { print ADJUST_OUT $_; last if /^\s*#+\s+end\s+config/i; # prevent parsing whole file next; } $line = $_; foreach $var (keys %vars) { if ($line =~ /^\s*(my\s+)?\$(\w+::)?$var\s*=\s*('?[^']+'?)\s*;/) { my $my = $1 || ''; my $pkg = $2 || ''; $check = $3 || ''; print "Found $var in $file\n" if $DEBUG; unless ($check eq $vars{$var}) { $changed++; $line = $my . '$' . $pkg . $var . ' = ' . $vars{$var} . ";\n"; print "Adjusted $var in $file\n" if $DEBUG; } delete $vars{$var}; } } print ADJUST_OUT $line; unless (scalar keys %vars) { last; } } if ($changed) { while() {print ADJUST_OUT $_} close ADJUST_IN; close ADJUST_OUT; unlink $bak; } else { close ADJUST_IN; close ADJUST_OUT; unlink $file; rename $bak, $file; } ! scalar keys %vars; } my %ModuleMessage = ( File::Basename => sub { $msg = < sub { my $msg = < sub { my $msg = < sub { if ($Config{'osname'} eq 'solaris') { warn < sub { "You have no Des.pm module, no biggie.\n" }, generic => sub { my $msg = <$file") || die "Couldn't create $file: $!\n"; while() { unless (/^\s*#*\s*use\s+/) { print ADJUST_OUT $_; last if /^\s*#+\s+end\s+config/i; # prevent parsing whole file next; } $line = $_; foreach $mod (@modules) { $found = 0; if ($line =~ /^\s*#*use\s+$mod\s?;?/ ) { eval { eval "require $mod" and $found = 1}; print "Found reference to module $mod in $file\n" if $DEBUG; if (!$found or $@) { $changed++ if $line =~ s/^(\s*)use/$1#use/; warn &{$ModuleMessage{$mod}}() . "\n" if defined $ModuleMessage{$mod}; warn &{$ModuleMessage{'generic'}}($mod) . "\n" if ! defined $ModuleMessage{$mod}; warn $found ? 'It was found but: ' : 'It was not found: ' . "\n$@\n" if $DEBUG; warn join "\n", '@INC was:', @INC, "" if $DEBUG; } else { $changed++ if $line =~ s/^(\s*)#(\s*)(use\s+)/$1$2$3/; } $check = $mod; last; } } @modules = grep ! ($_ eq $check), @modules; print ADJUST_OUT $line; unless (@modules) { last; } } if ($changed) { while() {print ADJUST_OUT $_} close ADJUST_IN; close ADJUST_OUT; unlink $bak; } else { close ADJUST_IN; close ADJUST_OUT; unlink $file; rename $bak, $file; } ! scalar @modules; } sub adjusttext { my ($file,$newfile,%text) = @_; my ($done,$origtext,$newtext); return undef unless (defined $file) && (defined %text) && (defined $newfile); open(ADJUST_IN,$file) || die "Couldn't open $file: $!\n"; open(ADJUST_OUT,">$newfile") || die "Couldn't create $newfile: $!\n"; while() { while( ($origtext,$newtext) = each %text) { if (/$origtext/) { s/$origtext/$Initial{$newtext}/g; print "Adjusted '$origtext' to '$Initial{$newtext}' in $file\n" if $DEBUG; } } print ADJUST_OUT $_; } close ADJUST_IN; close ADJUST_OUT; 1; } sub adjustdefs { my ($file,%defs) = @_; my $changed = 0; my $bak = 'mytemp.fil'; return undef unless $file && defined %defs; my $save = $; $ = 0; for(keys %defs) { $defs{$_} = qq|"$defs{$_}"| unless int($defs{$_}) eq $defs{$_}; } $ = $save; rename $file, $bak; open(ADJUST_IN,$bak) || die "Couldn't open $bak: $!\n"; open(ADJUST_OUT,">$file") || die "Couldn't create $file: $!\n"; while() { unless (/^#define/) { print ADJUST_OUT $_; next; } $line = $_; foreach $def (keys %defs) { my $val; if ($line =~ /^#define(\s+)$def(\s+)(.*)/) { my $sp1 = $1; my $sp2 = $2; my $val = $3; unless ( $val eq $defs{$def} ) { $changed++; $line = '#define' . $sp1 . $def . $sp2 . $defs{$def} . "\n"; print "Adjusted $def in $file\n" if $DEBUG; } delete $defs{$def}; } } print ADJUST_OUT $line; unless (scalar keys %defs) { last; } } if ($changed) { while() {print ADJUST_OUT $_} close ADJUST_IN; close ADJUST_OUT; unlink $bak; } else { close ADJUST_IN; close ADJUST_OUT; unlink $file; rename $bak, $file; } ! scalar keys %defs; } sub shbang { my $file = shift; my $perl = shift; my $changed = 0; my $bak = 'mytemp.fil'; return undef unless $file && $perl; rename $file, $bak; open(ADJUST_IN,$bak) || die "Couldn't open $bak: $!\n"; open(ADJUST_OUT,">$file") || die "Couldn't create $file: $!\n"; while() { if (/^(#\!\s*)(\S+)/) { my $precursor = $1; my $current = $2; unless ($perl eq $current) { $changed++; s/$current/$perl/; } } else { s/^/'#!' . $perl . "\n"/e; } print ADJUST_OUT $_; last; } if ($changed) { while() {print ADJUST_OUT $_} close ADJUST_IN; close ADJUST_OUT; print "Adjusted SHBANG in $file to $perl\n" if $DEBUG; unlink $bak; } else { close ADJUST_IN; close ADJUST_OUT; unlink $file; rename $bak, $file; } 1; } sub getvendsettings { my $file = shift; my($status,$key,$val); my(%settings); open(VENDSET, $file) || die "Couldn't open $file: $!\n"; while() { next if /^\s*#/; # Ignore comments next unless /\S/; # Ignore blanks chomp; ($key, $value) = split(/[\t =]+/, $_, 2); next unless $key =~ /\S/; $settings{$key} = $value; } close VENDSET; %settings; } sub findexe { my($exe) = @_; my($dir,$path) = ('', $ENV{PATH}); $path =~ s/\(\)//g; $path =~ s/\s+/\s/g; my(@dirs) = split /[\s:]+/, $path; foreach $dir (@dirs) { return "$dir/$exe" if -x "$dir/$exe"; } return ''; } sub writeconfig { my($file) = shift; my(@keys) = @_; my($status,$key,$val); open(WRITECONFIG, ">$file") || die "Couldn't write $file: $!, died"; if(grep /^PageDir/, @keys) { @keys = grep !/^PageDir/, @keys; unshift @keys, 'PageDir'; } for(sort @keys) { warn "Doing $_: Initial=$Initial{$_} Default=$Default{$_}\n" if $DEBUG; next if $Initial{$_} eq $Default{$_}; next unless $Initial{$_}; printf WRITECONFIG "%-20s %s\n", $_, $Initial{$_}; } close WRITECONFIG; return 1; } sub copyfiles { my ($srcdir,$targdir,@types) = @_; my (%types); my ($file, $tempfile, $source, $target); my $dirmode = $targdir =~ m#/$# ? 1 : 0; unless (scalar(@types)) { @types = grep !$types{$_}++, values %Type; } else { for(@types) { $types{$_} = 1 } } foreach $file (@Files) { next unless $types{$Type{$file}}; $source = "$srcdir/$file"; if($dirmode) { $tempfile = $file; $tempfile =~ s:.*/::; $target = $targdir . $tempfile; } else { $target = "$targdir/$file"; } if ($Type{$file} =~ /dir$/) { unless (-d $target) { mkdir $target, $Perms{$file} or die "Couldn't make directory $target: $!\n"; } if($Type{$file} =~ /odir/) { system "(cd $file; tar -cf - *) | (cd $target; tar -xf -)"; } } else { if(-f $target ) { if (defined $Funcs{$file} and $Funcs{$file} =~ /\bbackup\b/) { my $n = 0; my $backup; $backup = "$target~"; while (-f $backup) { $backup .= '~'; $n++; die "Too many backups of $target." if $n > 9; } warn "Saving old $target to $backup.\n"; cp($target, $backup) or die "Couldn't copy $target to $backup: $!\n"; } elsif ( !-w _ ) { next unless is_yes(prompt "Overwrite read-only file $target? ", 'no'); chmod 0644, $target; } } cp($source,$target) or die "Couldn't copy $source to $target: $!\n"; } if (defined $Funcs{$file} and $Funcs{$file} =~ /\bchown\b/) { chown ($UserID, $GroupID, $target) if defined $UserID; } chmod $Perms{$file}, $target || die "Couldn't change mode of $target to $Perms{$file}: $!\n"; } 1; } sub checkmanifest { my ($targdir,@types) = @_; my (%types); my (@errors); my ($file, $target); unless (scalar(@types)) { @types = grep !$types{$_}++, values %Type; delete $types{'link'}; } else { for(@types) { $types{$_} = 1 } } foreach $file (@Files) { next unless $types{$Type{$file}}; $target = "$targdir/$file"; push(@errors, "$target doesn't exist!") unless -e $target; } if (@errors) { push (@Errors, @errors); return undef; } 1; } sub finduid { my(@users) = @_; my ($user, $login,$pass,$uid,$gid); foreach $user (@users) { ($login,$pass,$uid,$gid) = getpwnam($user); last if defined $uid; } defined $uid ? $uid : ''; } sub get_detailed_param { my $param = shift; my $result; if($Help{$param}) { print "\n\n", $Help{$param}; } unless (defined $Initial{$param}) { $Initial{$param} = ($Default{$param} =~ /BLANK_DEFAULT|UNDEFINED/) ? '' : $Default{$param}; } $result = prompt("$param? ", $Initial{$param}); } ### Start main configuration if (open(HELP, $Initial{'HelpFile'})) { $/ = ''; while() { my ($thing, $comment) = split /\n/, $_, 2; my ($var, $default) = split /\s+/, $thing, 2; $Help{$var} = $comment; $Default{$var} = $default; } close HELP; $/ = "\n"; } else { die "Ooops! No helpfile. Can't continue.\n"; } require 5.002 || die <) { next if /^#/; next unless /\S/; chomp; ($file,$type,$perms,$funcs) = split /\s+/, $_, 4; push(@Files,$file); $Type{$file} = $type; $Perms{$file} = oct($perms); $Funcs{$file} = $funcs; } close MANIFEST; } else { $Nomove = 1; warn "\nCouldn't open manifest: $!\n" . "We won't be moving or changing any program files.\n"; } if($InstallOnly) { goto INSTALLPROGS; } if (checkmanifest('.')) { $Fullpackage = 1; $SamplesPresent = 1; print "\nYou seem to have a complete package here.\n"; } goto COPYFILES if $Rerun; $param = 'VendRoot'; my $save = $Initial{$param}; unless ( ($Initial{$param} = get_detailed_param($param)) eq $save) { chop($Initial{$param} = `pwd`) if $Initial{$param} eq '.'; $Changed{$param} = 1; } $Done{$param} = 1; CHECKMANIFEST: { last CHECKMANIFEST if $Nomove || $Fullpackage || $Rerun; unless (checkmanifest('.', 'dir', 'static', 'script', 'csrc', 'conf')) { $Nomove = 1; for (@Errors) { print "$_\n" } print "Not all the important files are here. I won't be copying files.\n"; @Errors = (); } else { print "You have the important files.\n"; } } # CHECKMANIFEST chop($curdir = `pwd`); $Samedir = 1 if $curdir eq $Initial{'VendRoot'}; COPYFILES: { my(@types); my($ans); last COPYFILES if $Nomove || $Rerun; if ($Fullpackage && $Samedir) { print < $_\n"; } print <. ------------------------------------------------------------------- EOF } use Config; if ($PERL) { $Initial{'PERL'} = $PERL; } HOSTNAME: { my $host; my $domain; # Have to skip this for NT unless (defined $Initial{'HostName'}) { $Initial{'HostName'} = ''; chop($host = `hostname`); last HOSTNAME if $?; chop($domain = `domainname`); last HOSTNAME if $?; $host .= ".$domain" if ($host =~ s/\.?\(?none\)?$//i or $host !~ /\./); $Initial{'HostName'} = $host; } } LOCK_GCC: { last LOCK_GCC unless $Config{'osname'} =~ /solaris/i; $GCCFLAG = ' -lsocket -DSVR4'; eval {require File::Lock and last LOCK_GCC }; print <