Skip to content
Find file
Fetching contributors…
Cannot retrieve contributors at this time
548 lines (488 sloc) 12.5 KB
# Copyright 2002-2007 Interchange Development Group and others
#
# 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. See the LICENSE file for details.
#
# $Id: xfer_catalog.coretag,v 1.7 2007-03-30 23:40:54 pajamian Exp $
UserTag xfer-catalog Order file
UserTag xfer-catalog addAttr
UserTag xfer-catalog Version $Revision: 1.7 $
UserTag xfer-catalog Routine <<EOR
sub {
my ($file, $opt) = @_;
my %dsn;
my %db;
my %export;
my %dbtype;
my %dbname;
my %user;
my %pass;
my $now = time();
my $root = $Vend::Cfg->{VendRoot};
my $catname = $Vend::Cfg->{CatalogName};
my @exclude = ("./$catname.tar.gz", './products/existing.site.txt');
my %exclude = (
tmp => ['./tmp/*'],
session => ['./session/*'],
usertrack => ["./$Vend::Cfg->{TrackFile}"],
orders => ["./logs/tracking.asc", './orders/*'],
survey => ["./logs/survey"],
logs => ['./logs/log', './error.log'],
backup => ['./backup/*'],
config => ['./config/*'],
upload => ['./upload/*'],
download => ['./download/*'],
);
my $export_and_exclude = sub {
my ($t, $o) = @_;
my $dbo = dbref($t);
$dbo = $dbo->ref() if $dbo;
$export{$t} = $o->{file};
my $dir = $o->{DIR};
my $dbf = $o->{db_file};
if($dbf =~ m{^/}) {
$dbf =~ s{^$root}{.};
}
elsif($dir =~ s{^$root}{.}) {
$dbf = "$dir/$dbf";
}
else {
::logDebug("Unrecognized db file $dbf");
}
push @exclude, $dbf;
};
my @restore = (<<'EOF');
#!/bin/sh
DIR=$1
USAGE="ic_restore.sh [directory]";
if test -n "$DIR"
then
cd $DIR || (echo "$DIR: does not exist"; echo $USAGE; exit 1);
fi
if test ! -d xfer/exports
then
echo "Not a restore directory for Interchange."
echo $USAGE
exit 1;
fi
cp -r xfer/exports/* products
EOF
my %maptype = (
mysql => {
restore => $::Variable->{RESTORE_COMMAND_MYSQL} || 'mysql',
create => $::Variable->{CREATE_COMMAND_MYSQL} || 'mysqladmin create %s',
command => $::Variable->{DUMP_COMMAND_MYSQL} || 'mysqldump --add-drop-table',
host => '-h %s',
port => '-p %s',
user => '-u %s',
pass => '-p%s',
},
Pg => {
restore => $::Variable->{RESTORE_COMMAND_PG} || 'psql -q',
create => $::Variable->{CREATE_COMMAND_PG} || 'createdb %s',
command => $::Variable->{DUMP_COMMAND_PG} || 'pg_dump -c -O',
host => '-h %s',
port => '-p %s',
user => '-U %s',
},
);
my %usermap = (
mysql => {
USER => '-u %s',
PASS => '-p%s',
},
Pg => {
USER => '-U %s',
},
);
my %dbparm = (
mysql => {
database => 1,
},
Pg => {
dbname => 1,
},
);
my $date = POSIX::strftime('%Y%m%d%H%M%S', localtime());
if(-e 'xfer') {
unless($opt->{backup_old}) {
File::Path::rmtree('xfer');
}
else {
rename 'xfer', "xfer.backup.$date";
}
}
File::Path::mkpath('xfer');
File::Path::mkpath('xfer/exports');
File::Path::mkpath('xfer/dumps');
while( my ($t, $o) = each %{$Vend::Cfg->{Database}} ) {
next if $t eq 'site';
#::logDebug("Parsing $t");
if(! $o) {
::logDebug("bad object=$o table=$t");
next;
}
#::logDebug("$t type=$o->{type}");
if($o->{type} != 8) {
$export_and_exclude->($t, $o);
next;
}
my $dsn = $o->{DSN};
#::logDebug("$t DSN=$o->{DSN}");
next if $dsn{$dsn};
my $dbstring = $dsn;
$dbstring =~ s/^dbi://i;
$dbstring =~ s/^(\w+)://i;
my $driver = $1;
#::logDebug("$t driver=$driver");
my $map = $maptype{$driver};
if(! $map) {
$export_and_exclude->($t, $o);
next;
}
$dbtype{$dsn} = $driver;
my $dbname;
my @pieces = split /\s*;\s*/, $dbstring;
my @args;
for(@pieces) {
#::logDebug("checking piece=$_");
if(/=/) {
my ($k, $v) = split /\s*=\s*/, $_;
$k = lc $k;
if(my $tpl = $map->{$k}) {
$tpl =~ s/\%s/$v/g;
push @args, $tpl;
}
elsif($dbparm{$driver}->{$k}) {
$dbname = $v;
}
else {
Vend::Tags->warnings("Unrecognized DSN atom '$_'");
next;
}
}
else {
$dbname = $_;
}
}
if(! $dbname) {
my $msg = "Unable to find dbname for $dsn.";
logError($msg);
return $msg if $opt->{show_error};
return;
}
$dbname{$dsn} = $dbname;
if (my $user = $o->{USER}) {
$user{$dsn} = $user;
my $tpl = $map->{user};
$tpl =~ s/\%s/$user/g
and push @args, " $tpl";
}
if (my $pass = $o->{PASS}) {
$pass{$dsn} = $pass;
my $tpl = $map->{pass};
$tpl =~ s/\%s/$pass/g
and push @args, " $tpl";
}
$dsn{$dsn} = join " ", $map->{command}, @args, $dbname;
}
for my $t (keys %export) {
$export{$t} =~ m{(.*)/}
and do {
my $dircomp = $1;
File::Path::mkpath("$root/xfer/exports/$dircomp");
};
Vend::Data::export_database($t, "$root/xfer/exports/$export{$t}", undef, {})
or logError("Failed to export table $t in xfer-catalog.");
}
for(keys %dsn) {
my $ext = $_ eq $::Variable->{SQLDSN} ? 'maindump' : 'dump';
my $cmd = "$dsn{$_} > xfer/dumps/$dbname{$_}.$dbtype{$_}.$ext";
#::logDebug("executing $cmd");
system $cmd;
if($?) {
my $status = $?;
my $err = $status >> 8;
my $msg = errmsg("error=%s, status=%s execuding dump '%s': %s", $err, $status, $cmd, $!);
::logDebug($msg);
::logError($msg);
return $msg if $opt->{show_error};
return;
}
}
if($opt->{keep_together} ||= $CGI::values{keep_together}) {
my @keys = grep /\w/, split /[\s,\0]+/, $opt->{keep_together};
for(@keys) {
#::logDebug("Setting keepname keep_$_");
$opt->{"keep_$_"} = 1;
}
}
for my $name (keys %exclude) {
my $kname = "keep_$name";
if(exists $opt->{$kname}) {
next if $opt->{$kname};
}
if ($CGI::values{$kname}) {
next;
}
push @exclude, @{$exclude{$name}};
}
my $excludestring = join("\n", @exclude, '');
#::logDebug("exclude:\n$excludestring");
unlink 'exclude-files';
Vend::File::writefile('exclude-files', $excludestring);
my @vars = qw/
CGI_URL
DOCROOT
IMAGE_DIR
ORDERS_TO
SAMPLEHTML
SAMPLEURL
SECURE_SERVER
SERVER_NAME
SQLDSN
SQLPASS
SQLUSER
IC_DIR
CGI_DIR
CGIWRAP
LINKMODE
LINKHOST
LINKPORT
LINKPORT
/;
if(defined $opt->{variables}) {
@vars = grep /\S/, split /[\s,\0+]/, $opt->{variables};
}
my $vdb = dbref('variable');
my @vdb = "code\tVariable\tpref_group";
my $imagebase;
## Don't really care if this fails
rename 'products/site.txt', 'products/existing.site.txt';
my @backups = '.';
my $newdriver;
my %restore;
for(@vars) {
my $val = $CGI::values{$_} || $::Variable->{$_};
my $pref = tag_data('variable', 'pref_group', $_);
push @vdb, join("\t", $_, $val, $pref);
if($_ eq 'SQLDSN') {
my $thing = $restore{sqldsn} = $val;
$thing =~ s/^dbi:(\w+)://i
and $newdriver = $1;
if($thing =~ /\bdatabase=(\w+)/ or $thing =~ /\bdbname=(\w+)/) {
$thing = $1;
}
$restore{dbname} = $thing;
}
elsif($_ eq 'DOCROOT') {
$restore{docroot} = $val;
$imagebase = $val if $val;
}
elsif($_ eq 'IMAGE_DIR') {
my $add = $val;
if($add =~ m{^http:}) {
undef $imagebase;
}
else {
$add =~ s{^/\~[^/]+}{};
$imagebase .= $add if $imagebase;
}
}
else {
$restore{lc $_} = $val;
}
}
#::logDebug("imagebase=$imagebase");
RESTOREBUILD: {
if($imagebase) {
push @backups, './images/*';
push @restore, <<EOF;
mkdir -p $imagebase
cp -r images/* $imagebase
rm -rf images
ln -s $imagebase images
EOF
}
last RESTOREBUILD unless $newdriver;
my @possible = glob('xfer/dumps/*.maindump');
if(@possible) {
my $m = $maptype{$newdriver}
or last RESTOREBUILD;
if(! $opt->{restore_command}) {
$opt->{restore_command} = $m->{restore}
or last RESTOREBUILD;
if($restore{sqluser}) {
my $tpl = $m->{user};
$tpl =~ s/\%s/$restore{sqluser}/g
and $opt->{restore_command} .= " $tpl";
}
if($restore{sqlpass}) {
my $tpl = $m->{pass};
$tpl =~ s/\%s/$restore{sqlpass}/g
and $opt->{restore_command} .= " $tpl";
}
$opt->{restore_command} .= ' %s';
$opt->{restore_command} .= ' < %f';
}
if($opt->{create_db} || $CGI::values{create_db}) {
$opt->{create_command} ||= $m->{create};
$opt->{create_command} =~ s/\%s/$restore{dbname}/g;
$opt->{create_command} .= ' 2> /dev/null'
unless $opt->{create_command} =~ /2\s*>/;
push @restore, $opt->{create_command};
}
else {
undef $opt->{create_command};
}
$opt->{restore_command} =~ s/\%s/$restore{dbname}/g;
$opt->{restore_command} =~ s/\%f/$possible[0]/g;
push @restore, $opt->{restore_command};
}
else {
undef $opt->{create_command};
undef $opt->{restore_command};
}
}
my $did_link;
my $did_catline;
RESTORECGI: {
last RESTORECGI if $restore{linkmode} =~ /none/i;
my $dest = $restore{cgi_dir};
my $progname = $restore{cgi_url};
$progname =~ s:.*/::;
$dest .= "/$progname";
my @args = "$restore{ic_dir}/bin/compile_link";
if($restore{linkmode} =~ /^u/i) {
push @args, '-u';
push @args, '-nosuid' if $restore{cgiwrap};
}
else {
push @args, '-i';
push @args, "-h $restore{linkhost}" if $restore{linkhost};
push @args, "-p $restore{linkport}" if $restore{linkport};
}
push @args, "-o $dest";
my $cstring = join " ", @args;
push @restore, "\n$cstring\n";
$did_link = 1;
}
my $newname = $CGI::values{rename} || $catname;
$restore{newname} = $newname;
ADDCATLINE: {
last ADDCATLINE unless $opt->{addcatline} ||= $CGI::values{addcatline};
$restore{perl} = $^X;
my $script = <<'EOScript';
#!__PERL__
use File::Copy;
use Cwd;
my $vendroot = '__IC_DIR__';
my $catalogname = '__NEWNAME__';
my $cgiurl = '__CGI_URL__';
my $aliases = '__CGI_ALIASES__';
my $targfile = "$vendroot/interchange.cfg";
unless ($vendroot and $catalogname and $cgiurl) {
die "xfer/modic_cfg.pl: Not all information necessary to add Catalog line.\n";
}
my $cur = cwd();
my $newcfgline = sprintf "%-10s %s %s %s %s\n", 'Catalog',
$catalogname, $cur, $cgiurl, $aliases;
my ($mark, @out);
my $tmpfile;
$tmpfile= "$targfile.$$";
if (-f $targfile) {
File::Copy::copy ($targfile, $tmpfile)
or die "\nCouldn't copy $targfile: $!\n";
}
else {
my @cf = ("$targfile.dist", "$vendroot/interchange.cfg.dist");
my $cf;
for(@cf) {
$cf = $_ if -f $_;
}
File::Copy::copy($cf, $tmpfile)
or die "\nCouldn't copy $cf: $!\n";
}
open(CFG, "< $tmpfile")
or die "\nCouldn't open $tmpfile: $!\n";
while(<CFG>) {
$mark = $. if /^#?catalog\s+/i;
print "\nDeleting old configuration $catalogname.\n"
if s/^(catalog\s+$catalogname\s+)/#$1/io;
push @out, $_;
}
close CFG;
if ($targfile) {
open(NEWCFG, ">$targfile")
or die "\nCouldn't write $targfile: $!\n";
} else {
open(NEWCFG, ">$targfile")
or die "\nCouldn't write $targfile: $!\n";
}
$newcfgline = sprintf "%-13s %s %s %s %s\n", 'Catalog',
$catalogname, $cur, $cgiurl, $aliases;
if (defined $mark) {
print NEWCFG @out[0..$mark-1];
print NEWCFG $newcfgline;
print NEWCFG @out[$mark..$#out];
}
else {
print "\nNo catalog previously defined. Adding $catalogname at top.\n";
print NEWCFG $newcfgline;
print NEWCFG @out;
}
close NEWCFG || die "close: $!\n";
unlink $tmpfile;
EOScript
$script =~ s/__([A-Z]\w+?)__/$restore{lc $1}/eg;
Vend::File::writefile('>xfer/addcatline.pl', $script );
push @restore, "\nperl xfer/addcatline.pl\n";
$did_catline = 1;
}
my $finmsg = <<EOThis;
Finished the restore script.
You should inspect the output above (if any) in case of errors.
EOThis
$finmsg .= <<EOThis unless $did_catline;
You will need to add the following line to interchange.cfg if
you haven't done so already:
Catalog $newname \$CURDIR $restore{cgi_url}
EOThis
$finmsg .= <<EOThis unless $did_link;
You will also need to copy an appropriate link program if it is
not already in place.
EOThis
push @restore, <<EOThis;
CURDIR=`pwd`
cat <<EOF
$finmsg
And of course you need to restart Interchange.
EOF
EOThis
Vend::File::writefile('>xfer/restore.sh', join ("\n", @restore, '') );
Vend::File::writefile('>products/site.txt', join("\n", @vdb, ""));
chmod 0755, 'xfer/restore.sh';
my $fstring = join " ", @backups;
my $cmdstring = "tar -X exclude-files -c -z -f $catname.tar.gz .";
#::logDebug("executing $cmdstring");
eval {
system $cmdstring;
};
## Don't really care if this fails
unlink 'products/site.txt';
rename 'products/existing.site.txt', 'products/site.txt';
if($?) {
my $status = $?;
my $err = $status >> 8;
my $msg = errmsg("error=%s, status=%s executing dump '%s': %s", $err, $status, $cmdstring, $!);
::logDebug($msg);
::logError($msg);
return $msg if $opt->{show_error};
return;
}
#return join("\n###\n", ::uneval(\%dsn), ::uneval(\%export), $excludestring);
return 1;
}
EOR
Something went wrong with that request. Please try again.