home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
rtsi.com
/
2014.01.www.rtsi.com.tar
/
www.rtsi.com
/
OS9
/
FAQ
/
cgi-bin
/
discus4_00
/
instsubs.pl
< prev
next >
Wrap
Perl Script
|
2009-11-06
|
7KB
|
257 lines
#!/usr/bin/perl
my $discus_version = "4.00";
###
### instsubs.pl - Subroutines to install Discus
###
if ($0 =~ /instsubs/) {
print "To install or upgrade Discus by telnet, use:\n";
print " 1st_install.pl -- first time installation\n";
print " upgrade.pl -- all subsequent upgrades\n";
print "\n";
print "This script, instsubs.pl, supports those scripts, but has\n";
print "no function when run by itself.\n\n";
my $foo = <STDIN>;
exit(0);
}
my $interactive = 1;
###
### install_discus
###
sub install_discus {
my ($upgrade, $d, $DC, $pathperl) = @_;
$DC->{language} = $DC->{language_chosen} if defined $DC->{language_chosen} && ! defined $DC->{language};
$DC->{language} =~ tr/A-Z/a-z/; $DC->{language} =~ s/\W//g;
my @filelist = ();
my $pro_fileid = "";
foreach my $k (keys %{$DC}) {
$DC->{$k} =~ s/\\/\//g if $k =~ /_dir$/;
}
if ($pathperl eq "") {
open (FILE, "< $DC->{script_dir}/board-admin.$DC->{cgi_extension}") || die "Open Error: Could not determine path to perl: $!\n";
my @file = <FILE>;
close (FILE);
$pathperl = $file[0];
$pathperl =~ s/^\s*#!\s*//;
}
if (-e "$DC->{admin_dir}/source") {
opendir(DIR, "$DC->{admin_dir}/source");
my @dir = grep { /^PRO_/ } readdir(DIR);
closedir(DIR);
if ($dir[0] =~ /^PRO_(\d+)/) {
$pro_fileid = $1;
}
}
if ($pro_fileid == 0) {
srand time;
$pro_fileid = "";
for (my $i = 1; $i <= 12; $i++) {
$pro_fileid .= int(rand(10));
}
}
if (open (FILELIST, "< ./source/filelist.txt")) {
while (<FILELIST>) {
my ($perms, $filename, $flags) = split(/\s+/, $_);
my $is_dir = $perms =~ /^d/;
my $perm = "777";
$perm = "777" if $perms =~ /rwxrwxrwx$/;
$perm = "666" if $perms =~ /rw-rw-rw-$/;
$perm = "755" if $perms =~ /rwxr-xr-x$/;
$perm = "644" if $perms =~ /rw-r--r--$/;
$perm = $DC->{perms0666} if $perms =~ /rw-rw-rw-$/ && $DC->{perms0666};
$perm = $DC->{perms0777} if $perms =~ /rwxrwxrwx$/ && $DC->{perms0777};
$perm = $DC->{perms0755} if $perms =~ /rwxr-xr-x$/ && $DC->{perms0755};
$flags = $1 if $flags =~ /^\[(.*)\]$/;
$filename = join("", $`, "PRO_$pro_fileid", $') if $filename =~ /PRO_##/;
my $filepath = $filename;
$filepath =~ s%^\./discus_admin%$DC->{admin_dir}%g;
if ($DC->{icon_dir} ne "" && $DC->{icon_dir} ne "icons") {
$filepath =~ s%^\./public_html/icons%$DC->{html_dir}/$DC->{icon_dir}%g;
}
$filepath =~ s%^\./public_html%$DC->{html_dir}%g;
$filepath =~ s%^\./cgi-bin%$DC->{script_dir}%g;
$filepath =~ s%\.cgi$%.$DC->{cgi_extension}% if $DC->{cgi_extension} ne "cgi" && $flags =~ /C/;
chmod (oct($perm), $filepath);
next if $flags =~ /\*/ && -e $filepath && $upgrade;
next if $DC->{pro} == 0 && $flags =~ /\%/;
if (-e $filepath && $flags =~ /^(\d+)/) {
$flags = $';
if ($d->{$1} eq "0" || ($d->{$1} ne "1" && $flags =~ /N/)) {
if ($flags =~ /<([\d\.]+)>/) {
$flags = join("", $`, $');
next if $DC->{version} >= $1;
} else {
next;
}
}
}
my $sourcefile = $' if $filename =~ /.*\//;
my $forcecode = "";
$forcecode = htaccess_source() if $flags =~ /~/;
$forcecode = nsconfig_source() if $flags =~ /`/;
$forcecode = "#\n" if $flags =~ /\*/ && $flags !~ /O/;
$forcecode = "\n" if $flags =~ /X/;
$forcecode = passwd_source($DC) if $flags =~ /P/;
push @filelist, {
filename => $sourcefile,
destfile => $filepath,
is_dir => $is_dir,
perm => $perm,
forcecode => $forcecode,
flags => $flags,
};
}
} else {
print "Error: could not open file list: $!\n";
exit(0);
}
process_entry($pathperl, $DC, @filelist);
$DC->{version} = $discus_version;
open (DCONF, "> $DC->{admin_dir}/discus.conf");
open (DCONF_LOCAL, "> ./discus.conf");
foreach my $k (keys %{$DC}) {
print DCONF "$k=$DC->{$k}\n";
print DCONF_LOCAL "$k=$DC->{$k}\n";
}
close (DCONF);
close (DCONF_LOCAL);
chmod (oct(777), "$DC->{admin_dir}/discus.conf");
open (FILE, ">> install.txt");
print FILE "Upgrade of $DC->{html_url} at ", scalar(localtime(time)), "\n" if $upgrade;
print FILE "Install of $DC->{html_url} at ", scalar(localtime(time)), "\n" if ! $upgrade;
close (FILE);
}
###
### process_entry
###
sub process_entry {
my $pathperl = shift;
my $DC = shift;
while (my $entry = shift) {
if ($entry->{is_dir}) {
next if -d $entry->{destfile};
if (-f $entry->{destfile}) {
if ($interactive) {
print "$entry->{destfile} is a file -- should be a directory\n";
print "Delete file to create directory? (y/n): ";
my $ch1 = <STDIN>;
exit(0) if $ch1 =~ /^n/i;
}
unlink $entry->{destfile};
}
mkdir($entry->{destfile}, oct($entry->{perm})) || die "Directory creation error for $entry->{destfile}: $!";
chmod(oct($entry->{perm}), $entry->{destfile});
} else {
next if $entry->{filename} eq "";
$entry->{filename} = "index.html" if $entry->{flags} =~ /i/;
if ($entry->{forcecode} ne "") {
open (FILE, "> $entry->{destfile}") || die "File write error for $entry->{destfile}: $!";
print FILE $entry->{forcecode};
close (FILE);
chmod (oct($entry->{perm}), $entry->{destfile});
} else {
open (FILE, "> $entry->{destfile}") || die "File write error for $entry->{destfile}: $!";
binmode FILE;
my @src = ();
if (open (SRC, "< ./source/languages/$DC->{language}/$entry->{filename}")) {
binmode SRC;
@src = <SRC>;
close (SRC);
} elsif (open (SRC, "< ./source/$entry->{filename}")) {
binmode SRC;
@src = <SRC>;
close (SRC);
} else {
die "File read error for $entry->{filename}: $!";
}
print FILE "#!$pathperl\n" if $entry->{flags} =~ /C/;
foreach $_ (@src) {
if ($entry->{flags} =~ /H/) {
s/\$html_url/$DC->{html_url}/g;
s/\$script_url/$DC->{script_url}/g;
s/\$cgi_extension/$DC->{cgi_extension}/g;
s%<!--TITLE-->(.*?)<!--/TITLE-->%<!--TITLE--><TITLE>$DC->{title}</TITLE><!--/TITLE-->%g;
s%<!--\*-->(.*?)<!--/\*-->%<!--\*-->$DC->{title}<!--/\*-->%g;
} elsif ($entry->{flags} =~ /C/) {
s/my \$DISCUS_CONF_DEFINITION = '(.*?)';/my \$DISCUS_CONF_DEFINITION = '$DC->{admin_dir}\/discus.conf';/g;
s/\$DCONF->\{script_dir\} = ".*?";/\$DCONF->\{script_dir\} = "$DC->{script_dir}";/g;
}
print FILE $_;
}
close (FILE);
chmod (oct($entry->{perm}), $entry->{destfile});
}
}
}
}
###
### htaccess_source
###
sub htaccess_source {
return "Order deny,allow\nDeny from all\nAllow from none\n";
}
###
### nsconfig_source
###
sub nsconfig_source {
return "<FILES *>\nRestrictAccess type=deny ip=*\n</FILES>\n";
}
###
### passwd_source
###
sub passwd_source {
my $DC = shift;
return "$DC->{superuser}::email:fullname:1::" . time . ":0:0:/\n";
}
###
### upgrade_or_not
###
sub upgrade_or_not {
my $z = shift;
print substr(join("", $z, " " x 60), 0, 60);
if ($_[0] eq "y") {
print "[Y/n]: ";
} else {
print "[y/N]: ";
}
my $uon = <STDIN>;
return 1 if $uon =~ /^y/i;
return 0 if $uon =~ /^n/i;
return 1 if $_[0] eq "y";
return 0;
}
###
### read_discus_conf
###
sub read_discus_conf {
my $file = -f $_[0] ? $_[0] : "./discus.conf";
open (FILE, "< $file") || die "Could not open discus.conf at [$file]: $!";
my $dc = {};
while (<FILE>) {
if (/^(\w+)=(.*?)\s*$/) {
$dc->{$1} = $2;
}
}
close (FILE);
return $dc;
}
1;