dist/bin/reconfig

#!/usr/bin/perl
#
# reconfig - script for user reconfiguration of MiniVend catalog
#
# This script differs from the one provided in the named templates
# in that it will reconfigure a named catalog if you configure the
# variables $Store and $ScriptDir properly.
# 

use Getopt::Std;
use CGI;

$VendRoot = $VendRoot || '/home/minivend';
## END CONFIGURABLE VARIABLES

BEGIN {
    eval {
        require 5.004;
        require FindBin;
        $VendRoot = $FindBin::RealBin;
        $VendRoot =~ s/.bin$//;
    };
    ($VendRoot = $ENV{MINIVEND_ROOT})
        if defined $ENV{MINIVEND_ROOT};
}

my $query;

$USAGE = <<EOF;
Reconfigure a MiniVend catalog. Will read information from
configuration file.

usage: reconfig [-i] [-e executable] store_id

	-e executable    Proper executable if not in $VendRoot/bin/vlink
	-i               Use $VendRoot/bin/tlink for INET mode

If called as a CGI program, ignores command line options.
EOF

unless (@ARGV) {
	$query = new CGI;
}
else {
	getopts('im:e:') or die "Couldn't get options: $@\n$USAGE\n";
	$Store = shift || die "usage: reconfig store_id\n";
}

# Parse the minivend.cfg file to look for script/catalog info
PARSECFG: {
	my $file;
	my @cfglines;

	$file = "$VendRoot/minivend.cfg";
	open(MVCFG, $file) or die "Couldn't read $file: $!\n";
	while(<MVCFG>) { push(@cfglines, $_) if /^\s*(sub)?catalog\s+/i }
	close MVCFG;

	eval {
		$file = "$VendRoot/catalogs.list";
		open(MVCFG, $file) or die "Couldn't read $file: $!\n";
		while(<MVCFG>) { push(@cfglines, $_) if /^\s*(sub)?catalog\s+/i }
		close MVCFG;
	};
	eval {
		$file = "$VendRoot/active.catalogs";
		open(MVCFG, $file) or die "Couldn't read $file: $!\n";
		while(<MVCFG>) { push(@cfglines, $_) if /^\s*(sub)?catalog\s+/i }
		close MVCFG;
		rename $file, "$file.bak";
	};
	my %seen;
	@cfglines = grep !$seen{$_}++, @cfglines;

	$file = "$VendRoot/etc/active.catalogs";
	open(MVOUT, ">$file") or die "Couldn't write $file: $!\n";
	
	my($name,$script,@vals);
	for(@cfglines) {
		next unless /^\s*(sub)?catalog\s+/i;
		print MVOUT $_;
		chomp;
		@vals = split /\s+/, $_;
		shift @vals if $vals[0] =~ /sub/i;
		$vals[3] =~ s:^([^/]+):: and $Servers{$vals[1]} = $1;
		$Dirs{$vals[1]} = $vals[2];
		$Scripts{$vals[1]} = $vals[3];
	}

	close MVOUT;

}

unless (defined $Scripts{$Store}) {
	die "$Store is not a configured catalog.\n";
}

$Script = $Scripts{$Store};

# Only used if problem with reconfiguration
$Dir	= $Dirs{$Store};


# Values for the demo, refresh is almost always right.
# You could put in some other stuff here to save a
# reconfiguration report in the session database. The
# defaults should work well unless you have heavily
# reconfigured the catalog
my %preset = (
			mv_doit => 'refresh',
			remote_host => $ENV{REMOTE_HOST},
			remote_addr => $ENV{REMOTE_ADDR},
			remote_user => $ENV{REMOTE_USER},
			user_agent => $ENV{HTTP_USER_AGENT},
			mv_orderpage => 'special/reconfig',
			);

$ENV{SERVER_NAME} = $Servers{$Store} if $Servers{$Store};

### END CONFIGURABLE VARIABLES

use FileHandle;
use POSIX 'tmpnam';
use strict;
use vars qw($USAGE $Store $Dir $VendRoot %Scripts %Dirs
			$ScriptDir $ScriptPath $Script $Prompt $opt_i $opt_e);

$ENV{PATH} = "/bin:/usr/bin";
$ENV{IFS} = "";

my %env = (
	REQUEST_METHOD			=> 'POST',
	CONTENT_TYPE			=> 'application/x-www-form-urlencoded',
	SCRIPT_NAME				=> $Script,
	PATH_INFO				=> '/process',
	REMOTE_USER				=> 'LOCAL',
	REMOTE_ADDR				=> 'LOCAL',
);

# 
# Must generate one with htpasswd.pl or the like and install it
# as Password directive in catalog.cfg for it to work
#

GETPASS: {

	my $pass = '';

	if (defined $ENV{GATEWAY_INTERFACE}) {
	# Allow passing of the password with query string parameter 
	# 'password' if CGI.
	#
	# Not very secure -- HTTP basic auth is better, as is POST.
	# You can add in the POST code if you wish.
		$pass = $ENV{QUERY_STRING};
		if( $ENV{QUERY_STRING} !~ /=/) {
			$pass =~ s!.*\+!!;
		}
		else {
			$pass =~ s!^.*password=!!;
			$pass =~ s!&.*!!;
		}
		$env{RECONFIGURE_MINIVEND} = $pass;
	}
	else {
		$env{RECONFIGURE_MINIVEND} = "";
		last GETPASS unless $Prompt;
		system("stty -echo"); 				 # Turn off echo
		print				"Password:";     # Prompt
		chomp				($pass = <>);    # Get new password
		system("stty echo"); 				 # Turn echo back on
		print 				"\n";			 # Return wasn't echoed, supply
		$env{RECONFIGURE_MINIVEND} = $pass;
	}

}

$ScriptPath = "$VendRoot/bin/vlink";

if ($opt_e) {
	die "-i and -e are mutually exclusive.\n$USAGE\n"
		if $opt_i;
	$ScriptPath = $opt_e;
}
elsif($ =~ /win32/i) {
	$ScriptPath = "$VendRoot/bin/tlink.exe";
}
elsif($opt_i or -f "$VendRoot/etc/mode.inet") {
	$ScriptPath = "$VendRoot/bin/tlink";
}

my %Data;

my($user,$path);

my $tried = 0;

sub die_page {
	my $string = shift;
	print <<EOF;
Content-type: text/html

<HTML>
<HEAD><TITLE>Error: $string</TITLE></HEAD>
<BODY BGCOLOR=WHITE>

<H2>Error: $string</H2>

Store=$Store<BR>
Script=$Script<BR>
QUERY=$ENV{QUERY_STRING}<BR>
EOF
	for(@ARGV) {
		print "arg=$_<BR>\n";
	}
	print "No args.<BR>\n" unless @ARGV;

	print <<EOF;
<P>
Check the error log for problems in configuration:<BR>
(<A HREF="#ten">10 lines from bottom</A>)
<PRE>
EOF
	my $fi = "$Dir/error.log";
	my @lines;
	eval {
		if( open ERRS, $fi ) {
			seek(ERRS, -10000, 2)	or
				seek (ERRS, 0, 0)	or
					die "seek $fi: $!\n";
			my $contents;
			if (read(ERRS, $contents, 10000) ) {
				$contents =~ s/^.*//;
				@lines = reverse split /\n/, $contents;
				$lines[9] = "<A NAME=ten>$lines[9]</A>";
			}
		}
		else {
			die "Error log not readable.\n";
		}
	};
	if($@) {
		print $@;
	}
	else {
		for (reverse @lines) {
			print "$_\n"; 
		}
	}
	print <<EOF;
</PRE>
</BODY>
</HTML>
EOF
	exit 0;
}


# Taken from URI::Escape to avoid distributing a module
# Thanks, libwww team!
sub uri_escape
{
    my($text, $patn) = @_;
	my %escapes;

	no strict 'vars';  # URI::Escape non-strict
	# Build a char->hex map
	for (0..255) {
		$escapes{chr($_)} = sprintf("%%%02X", $_);
	}
    return undef unless defined $text;
    if (defined $patn){
    unless (exists  $subst{$patn}) {
        # Because we can't compile regex we fake it with a cached sub
        $subst{$patn} =
          eval "sub {\$_[0] =~ s/([$patn])/\$escapes{\$1}/g; }";
        die("uri_escape: $@") if $@;
    }
    &{$subst{$patn}}($text);
    } else {
    # Default unsafe characters. (RFC1738 section 2.2)
    $text =~ s/([\x00-\x20"#%;<>?{}|\\\\^~`\[\]\x7F-\xFF])/$escapes{$1}/g; #"
    }
    $text;
}

# Main program
	my ($var,$value);
	my $out = '';
	my @out;
	my $join = '';

	# Put in the preset values
	for (keys %preset) {
		push @out, "$_=" . uri_escape($preset{$_});
	}

	$out = join '&', @out;

	$env{CONTENT_LENGTH} = length $out;

	for(keys %env) {
		$ENV{$_} = $env{$_};
	}

	my $tmpfile = POSIX::tmpnam();

	open(VLINK, "|$ScriptPath > $tmpfile") or die "Couldn't return data: $!\n";
	print VLINK $out;
	close VLINK;


	if(! -s $tmpfile) {
		unlink $tmpfile;  # Need to duplicate

		if (defined $ENV{GATEWAY_INTERFACE}) {
			# For calling by CGI
			die_page "Reconfiguration failed.\n";
		}
		else {
			# For calling from command line
			die "Reconfiguration failed.\n";
		}
	}
	elsif (defined $ENV{GATEWAY_INTERFACE}) {
		open(OUTPUT, "$tmpfile") or die "Couldn't return data: $!\n";
		while(<OUTPUT>) { print }
		close OUTPUT;
	}

	unlink $tmpfile;

	exit 0;