Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

executable file 345 lines (313 sloc) 10.916 kB
#!/usr/bin/perl -w
# This code is a part of Slash, and is released under the GPL.
# Copyright 1997-2005 by Open Source Technology Group. See README
# and COPYING for more information, or see http://slashcode.com/.
# $Id$
# By Jamie McCarthy, jamie@slashdot.org
# Based on template-tool, by Cliff Wood, Patrick Galbraith, Brian Aker
#
# STILL UNDER TESTING -- handles plugins now -- for now,
# be sure to use -T on any production site just in case this
# screws something up!!!
use strict;
use File::Basename;
use File::Path;
use File::Spec::Functions qw( :DEFAULT splitpath );
use Slash;
use Slash::Utility;
use Slash::DB;
use Slash::Install;
use Getopt::Std;
(my $VERSION) = ' $Revision$ ' =~ /\$Revision:\s+([^\s]+)/;
my $PROGNAME = basename($0);
my %opts;
my $symlink_exists = eval { symlink("",""); 1 };
if (!$symlink_exists) {
print STDERR "Sorry - symlink() not implemented on your system,\n";
print STDERR "so (duh!) symlink-tool cannot run.\n";
exit 1;
}
# Remember to doublecheck these match usage()!
usage('Options used incorrectly')
unless getopts('hvu:TtUV', \%opts);
usage() if $opts{h} || !keys %opts;
version() if $opts{v};
usage('Right now only -U does anything') if !$opts{U};
my $testing = $opts{T} ? 1 : ($opts{t} ? 1 : 0);
my $verbose = $opts{V} ? 1 : 0;
my $virtuser = $opts{u} || 'slash';
createEnvironment($virtuser);
my @dotfiles = ( );
my $slashdb = getCurrentDB();
my $constants = getCurrentStatic();
my $install = Slash::Install->new($virtuser);
# This will read all the themes and all the plugins available for this
# installation.
my $get_theme = $install->get("theme");
die "cannot get theme, DB probably unreachable" if !$get_theme;
my $site_theme = $get_theme->{value};
my $site_plugins = $install->get("plugin");
my @site_plugins = sort
map { $site_plugins->{$_}{value} }
keys %$site_plugins;
# What one theme, and what subset of the available plugins, is this
# site using?
my $theme_hr = $install->_getList(
$constants->{slashdir}, "themes", "THEME", 1
)->{$site_theme};
my $plugin_list = $install->_getList(
$constants->{slashdir}, "plugins", "PLUGIN", 1
);
############################################################
# Set up the %theme_subdir_files and %plugin_subdir_files hashes,
# to have a list of all the files that our theme references.
my %theme_subdir_files = ( );
my %plugin_subdir_files = ( );
# First, pull in the files referenced by the theme.
my @theme_htdocs_keys = grep /^(htdoc|image|topic)/, keys %$theme_hr;
for my $key (@theme_htdocs_keys) {
next unless $key && $theme_hr->{$key};
push @{$theme_subdir_files{htdocs}},
ref($theme_hr->{$key}) && ref($theme_hr->{$key}) eq 'ARRAY'
? @{$theme_hr->{$key}}
: $theme_hr->{$key};
}
for my $key (qw( tasks misc )) {
my $src_key = $key;
$src_key =~ s/s$//; # theme "task" becomes theme_subdir_files "tasks"
next unless $theme_hr->{$src_key};
@{$theme_subdir_files{$key}} =
ref($theme_hr->{$src_key}) && ref($theme_hr->{$src_key}) eq 'ARRAY'
? @{$theme_hr->{$src_key}}
: $theme_hr->{$src_key};
}
# Then, pull in the files referenced by each plugin used.
my %plugin_htdocs_keys = ( );
my @plugin_htdocs_keys = ( );
for my $plugin (keys %$plugin_list) {
for my $key (grep /^(htdoc|image|topic)/, keys %{$plugin_list->{$plugin}}) {
$plugin_htdocs_keys{$key} = 1;
}
}
@plugin_htdocs_keys = sort keys %plugin_htdocs_keys;
for my $plugin (keys %$plugin_list) {
my $plugin_hr = $plugin_list->{$plugin};
for my $key (@plugin_htdocs_keys) {
next unless $key && $plugin_hr->{$key};
push @{$plugin_subdir_files{$plugin}{htdocs}},
ref($plugin_hr->{$key}) && ref($plugin_hr->{$key}) eq 'ARRAY'
? @{$plugin_hr->{$key}}
: $plugin_hr->{$key};
}
for my $key (qw( tasks misc )) {
my $src_key = $key;
$src_key =~ s/s$//; # plugin "task" becomes "tasks"
next unless $plugin_hr->{$src_key};
@{$plugin_subdir_files{$plugin}{$key}} =
ref($plugin_hr->{$src_key}) && ref($plugin_hr->{$src_key}) eq 'ARRAY'
? @{$plugin_hr->{$src_key}}
: $plugin_hr->{$src_key};
}
}
#use Data::Dumper;
#print "theme_hr: " . Dumper($theme_hr);
#print "plugin_list: " . Dumper($plugin_list);
#print "theme_subdir_files: " . Dumper(\%theme_subdir_files);
#print "plugin_subdir_files: " . Dumper(\%plugin_subdir_files);
my $theme_dir = $theme_hr->{dir};
my $site_dir = $constants->{datadir};
if (!$testing && !-w $site_dir) {
print STDERR "No write access to '$site_dir'\n";
print STDERR "for EUID $>, cannot write any files\n";
exit 1;
}
my %processed = ( );
my $num_changes = 0;
for my $subdir (sort keys %theme_subdir_files) {
my @files = sort @{$theme_subdir_files{$subdir}};
for my $target_file (@files) {
# Strip off "../slashcode/" from front to find
# where the symlink was installed in the
# "site/foo" tree.
my $theme_file_abs = canonpath(catfile($theme_dir, $target_file));
1 while $theme_file_abs =~ s{/[^/]+/\.\.}{};
my $site_rel_file = $target_file;
1 while $site_rel_file =~ s{^\.\.\/[^/]+/}{};
my $site_file_abs = canonpath(catfile($site_dir, $site_rel_file));
if ($processed{$site_file_abs}) {
if ($verbose) {
print "Skipping file in theme, already processed: '$site_file_abs'\n";
}
next;
}
my $site_file_abs_dot = dotfile($site_file_abs);
my $site_file_abs_dot_short = dotfile($site_rel_file);
# At this point, $site_file_abs is e.g.
# '/usr/local/slash/site/mysite/tasks/spamarmor.pl'
# $site_file_abs_dot is e.g.
# '/usr/local/slash/site/mysite/tasks/.spamarmor.pl'
# $theme_file_abs is e.g.
# '/usr/local/slash/theme/slashcode/tasks/spamarmor.pl'
$num_changes += handle_file($site_file_abs, $theme_file_abs,
$site_file_abs_dot, $site_file_abs_dot_short);
$processed{$site_file_abs} = 1;
}
}
for my $plugin (sort keys %plugin_subdir_files) {
my $plugin_hr = $plugin_subdir_files{$plugin};
my $plugin_dir = $plugin_list->{$plugin}{dir};
for my $subdir (sort keys %$plugin_hr) {
my @files = sort @{$plugin_hr->{$subdir}};
#print "plugin '$plugin' subdir '$subdir' files '@files'\n";
for my $target_file (@files) {
my $plugin_file_abs = canonpath(catfile($plugin_dir, $target_file));
1 while $plugin_file_abs =~ s{/[^/]+/\.\.}{};
my $site_rel_file = $target_file;
1 while $site_rel_file =~ s{^\.\.\/[^/]+/}{};
# Plugins don't get the type prepended so we need to
# do that here.
$site_rel_file =~ s{^(?:$subdir/)?}{$subdir/};
my $site_file_abs = canonpath(catfile($site_dir, $site_rel_file));
#print "plugin '$plugin' subdir '$subdir' site_rel_file '$site_rel_file' site_file_abs '$site_file_abs'\n";
if ($processed{$site_file_abs}) {
if ($verbose) {
print "Skipping file in '$plugin' plugin, already processed: '$site_file_abs'\n";
}
next;
}
my $site_file_abs_dot = dotfile($site_file_abs);
my $site_file_abs_dot_short = dotfile($site_rel_file);
# At this point, $site_file_abs is e.g.
# '/usr/local/slash/site/mysite/tasks/adminmail.pl'
# $site_file_abs_dot is e.g.
# '/usr/local/slash/site/mysite/tasks/.adminmail.pl
# $plugin_file_abs is e.g.
# '/usr/local/slash/plugin/Stats/adminmail.pl'
$num_changes += handle_file($site_file_abs, $plugin_file_abs,
$site_file_abs_dot, $site_file_abs_dot_short);
$processed{$site_file_abs} = 1;
}
}
}
if ($num_changes == 0) {
print "symlink-tool -U: no symlink changes necessary\n";
}
if (@dotfiles) {
print "symlink-tool: found dotfiles: @dotfiles\n";
}
###############################################
sub handle_file {
my($symlink_file, $target_file, $symlink_file_dot, $symlink_file_dot_short) = @_;
if (!-e $target_file) {
print "Target file '$target_file' missing, can't create symlink\n";
return 1;
}
if (!-e $symlink_file && -e $symlink_file_dot) {
# The symlink file is missing and in its place is a
# dotfile. This site must have that file disabled,
# perhaps temporarily. Make sure it's correct; do
# what we were doing to do on the real file, on the
# dotfile instead.
$symlink_file = $symlink_file_dot;
push @dotfiles, $symlink_file_dot_short;
if ($verbose) {
print "Checking dotfile replacement at '$symlink_file'\n";
}
}
if (-e $symlink_file && !-l $symlink_file) {
# The file in place is not a symlink; compare it to
# what it should be and only replace it with a symlink
# if the two are identical.
my $diff;
if ($verbose) {
$diff = system("diff -U3 $target_file $symlink_file");
} else {
$diff = system("diff -U3 $target_file $symlink_file > /dev/null");
}
if ($diff) {
print "File should be symlink, but is not, and differs from intended target: '$symlink_file' '$target_file'; difference needs to be resolved or symlink-tool will not touch it\n";
return 1;
} else {
print "File at '$symlink_file' is not a symlink, but is identical to what it should be; ";
if ($testing) {
print "file would be unlinked and allowed to be recreated.\n";
return 1;
} else {
print "unlinking; will be created next.\n";
unlink $symlink_file;
}
}
}
lstat($symlink_file);
if (!-e _) {
print "Symlink at '$symlink_file' missing, ";
if ($testing) {
print "would create: '$target_file'\n";
return 1;
}
my $success = symlink($target_file, $symlink_file);
if (!$success) {
print "attempt to create FAILED: $!\n";
return 1;
}
print "successfully added link to '$target_file'\n";
return 1;
}
my $cur_target_file = readlink($symlink_file);
if ($cur_target_file eq $target_file) {
if ($verbose) {
print "Correct: $symlink_file -> $target_file\n";
}
return 0;
}
print "Symlink at '$symlink_file' mispointed at '$cur_target_file', ";
if ($testing) {
print "would repoint to '$target_file'\n";
return 1;
}
my $success = unlink $symlink_file;
if (!$success) {
print "attempt to unlink FAILED: $!\n";
return 1;
}
$success = symlink($target_file, $symlink_file);
if (!$success) {
print "original unlinked, attempt to link properly FAILED: $!\n";
return 1;
}
print "successfully relinked to '$target_file'\n";
return 1;
}
###############################################
sub dotfile {
my($file_abs) = @_;
my($volume, $dirs, $file) = splitpath($file_abs);
return "$dirs.$file";
}
###############################################
sub usage {
print "*** $_[0] \n" if $_[0];
print <<EOT;
Usage: $PROGNAME [OPTIONS] <template templateN>
Main options:
-h Help (this message)
-v Version
-u Virtual user (default is "slash")
-t Test run, report but don't do anything
-T Synonym for -t
-U Upgrade your symlinks to the latest for your theme and plugins
Debugging options:
-V Increases verbosity.
EOT
exit 0;
}
###############################################
sub version {
print <<EOT;
$PROGNAME $VERSION
This code is a part of Slash, and is released under the GPL.
Copyright 1997-2005 by Open Source Technology Group. See README
and COPYING for more information, or see http://slashcode.com/.
EOT
exit 0;
}
Jump to Line
Something went wrong with that request. Please try again.