#!/usr/bin/perl -w
# $Id: install_twiki.cgi 7202 2005-10-28 20:36:14Z WillNorris $
# Copyright 2004,2005 Will Norris.  All Rights Reserved.
# License: GPL
use strict;
#use Data::Dumper qw( Dumper );
++$|;

################################################################################
# CGI parameters:
# force: force (re)installation, even if twiki/ directory is already present
# perl: name of perl executable (autodetected, but can be manually overridden)
# kernel: name of kernel to install (eg, TWikiKernelDEVELOP7684)
# extension: name of extensions to install (BlogPlugin, ImageGalleryPlugin, PublishContrib)
# TWikiFor: 
#
# TODO parameters:
# administrator ($twikiAdmin)
#	(and update Main.TWikiAdminGroup)
# wikiwebmaster (for email about this wiki site) - 
#	(and update TWiki.MainPreferences) - $wikiWebMaster
#
# other TODO?
# 	could create a TWikiInstallationReport topic...
################################################################################

BEGIN {
#    mkpath "lib/CPAN/lib/";
    use lib qw( lib/CPAN/lib/ lib/CPAN/lib/arch/ );
};

use File::Path qw( mkpath rmtree );
use CGI qw( :standard );
use FindBin;
use File::Basename qw( basename );
use Cwd qw( abs_path );
use English;
#use WWW::Mechanize::TWiki 0.08;
#use Error qw( :try );

my $q = CGI::new() or die $!;
# object data
my $LocalSiteCfg;
my $twikiAdmin = $q->param('TWikiAdmin') || '';
my $wikiWebMaster = $q->param('WIKIWEBMASTER') || $ENV{SERVER_ADMIN};
my $TWikiFor = $q->param('TWikiFor');
#my $TWikiFor = $q->param('TWikiFor') || 'http://localhost/~twikibuilder/twiki.org.zip';
my $perl = $q->param( 'perl' ) || $EXECUTABLE_NAME;

################################################################################

print $q->header(),
    $q->start_html( -title => 'TWiki Installer',
		    -style => { -code => <<__CSS__ },
html, body, table, tr, td, td p  { padding:0em; margin:0em; }
html body { background:#FAFAF0; margin:0.2em 0 0.1em 0.2em; font-size:0.9em; }
td { padding:0.1em; }
.configuration { padding:1em 0; }
h1 { font-size:1.5em; }
.kernel { }
.extension { }

body { background-color:#D6000F; color:#222222; }
h1 { color:#ff6900; }
td:hover { background-color:#aa0000; }
a:link { color:#F4C000; }
a:hover:link { background-color:#F4C000; }
a:hover:link, td:hover { color:#FBF7E8; }
__CSS__
    ),
    $q->h1( 'TWiki Installer' )
    ;

################################################################################

my %installedPlugins;	# which plugins get installed/are encountered
my $twikiDir = "$FindBin::Bin/twiki";

my ( $twikiPath ) = $ENV{SCRIPT_NAME} =~ m|(.*)/.*|;		# remove the script name from the path
$twikiPath .= '/twiki';

my ( $scriptSuffix ) = $ENV{SCRIPT_NAME} =~ m|.*/.*(\..*)$|;
$scriptSuffix ||= '';

my $localDirConfig = {
    # SMELL: doesn't handle httpS --- what happened to $ENV{SCRIPT_URI} ???
	DefaultUrlHost   => "http://$ENV{HTTP_HOST}" . ( $ENV{SERVER_PORT} != 80 && ":$ENV{SERVER_PORT}" || '' ),
	ScriptUrlPath    => "$twikiPath",
	ScriptSuffix     => $scriptSuffix,
	PubUrlPath       => "$twikiPath/pub",
	PubDir           => "$twikiDir/pub",
	TemplateDir      => "$twikiDir/templates",
	DataDir          => "$twikiDir/data",
	LocalesDir       => "$twikiDir/locale",
	LogDir           => "$twikiDir/data",	# ???
    };

my $mapTWikiDirs = {
    lib       => { perms => 0440, dest => "$twikiDir/lib", },
    pub       => { perms => 0660, dest => $localDirConfig->{PubDir}, },
    data      => { perms => 0660, dest => $localDirConfig->{DataDir}, },
    templates => { perms => 0440, dest => $localDirConfig->{TemplateDir}, },
    bin       => { perms => 0550, dest => "$twikiDir", },
    locale    => { perms => 0440, dest => $localDirConfig->{LocalesDir}, },
#    log => ?
};

################################################################################
# already installed?
################################################################################
if ( -d "$FindBin::Bin/twiki" && !$q->param( 'force' ) ) {
    print $q->p( "TWiki is already installed! (you can ", $q->tt( 'force=1' ), " a (re)installation)" );

    print $q->p( $q->a( { -href => continueToWikiUrl() }, "Proceed to the wiki" ) );

    exit 0;
}

################################################################################

sub continueToWikiUrl
{
    # TODO: need URI for "view"
    do "twiki/lib/TWiki.cfg";
    do "twiki/lib/LocalSite.cfg";
    my $url = $TWiki::cfg{DefaultUrlHost} . $TWiki::cfg{ScriptUrlPath} 
    . '/view'.$TWiki::cfg{ScriptSuffix}
    . '/TWiki/InstalledPlugins';

    return $url;
}


################################################################################

unless ( $TWikiFor )
{
    print twikiForMenu( $q ),
    	$q->end_html;
    exit 0;
}

my $tmpInstall = "$FindBin::Bin/twiki/tmp/install/";
mkpath $tmpInstall;

my $archive_file = 'install.zip';
unless ( -e $archive_file ) {
    my ( $tar, $error ) = getUrl({ url => $TWikiFor, outfile => $archive_file });
    die $error if $error;

    open( TAR, '>', $archive_file ) or die $!;
    binmode( TAR );
    print TAR $tar;
    close TAR;
}

# SMELL: remove unless (but test speed; unzip with some option? (like refresh)
unless ( -d "$tmpInstall/components/" ) {
    my $archive = Archive::Zip::CommandLine->new( $archive_file ) or die "No $archive_file";
    $archive->extractTree( '', $tmpInstall );
}

if ( ( $q->param('kernel') || '' ) =~ /^LATEST$/i ) {
    $q->param( kernel => basename( (reverse sort { 
	( $a =~ /.+?(\d+)/ )[0] <=> ( $b =~ /.+?(\d+)/ )[0] } 
				    <$tmpInstall/components/kernel/*> )[0] 
				   ) =~ /(.*)\./ );
}

if ( grep( /^all$/i, ( $q->param('extension') ) ) ) {
    $q->param( -name => 'extension', 
	       -value => [ sort map { basename /(.*)\./ } <$tmpInstall/components/extension/*> ],
	       );
}

# set KERNEL and EXTENSION
if ( lc( $q->param('install') || '' ) ne 'install' ) {
    if ( $q->param('customise') ) {
	# present configuration page if customised setup has been chosen
	print installationMenu( $q ),
    	$q->end_html;
	exit 0;
    }
    else {
	# set the defaults for a completely automated install
	$q->param( kernel => basename( (reverse sort { 
	    ( $a =~ /.+?(\d+)/ )[0] <=> ( $b =~ /.+?(\d+)/ )[0] } 
					<$tmpInstall/components/kernel/*> )[0] 
				       ) =~ /(.*)\./ );
	$q->param( -name => 'extension', 
		   -value => [ qw( CpanContrib TWikiInstallerContrib TWikiPluginInstallerContrib ) ],
		   );
    }
}

################################################################################
# do the INSTALLATION

-d $twikiDir || mkpath $twikiDir or die qq{Couldn't create "$twikiDir" to install into!};
foreach my $type qw( kernel extension ) {
    map { InstallTWikiExtension( "$tmpInstall/components/$type/$_.zip" ) } ( sort $q->param($type) );
}

################################################################################
# LocalLib.cfg
my $fnLocalLibCfg = "$mapTWikiDirs->{bin}->{dest}/LocalLib.cfg";
open( FH, '>', $fnLocalLibCfg ) or die "Can't open $fnLocalLibCfg: $!";
print FH <<'__LOCALLIB_CFG__';
use vars qw( $twikiLibPath );
use Cwd qw( abs_path );
( $twikiLibPath ) = ($twikiLibPath = Cwd::abs_path( "lib" )) =~ /(.*)/;
1;
__LOCALLIB_CFG__
close( FH ) or die "Can't close $fnLocalLibCfg: $! ???";

################################################################################
# LocalSite.cfg

foreach my $plugin ( sort { lc $a cmp lc $b } keys %installedPlugins ) {
    $LocalSiteCfg .= "\$TWiki::cfg{Plugins}{$plugin}{Enabled} = 1;\n";
}

$LocalSiteCfg .= <<__LOCALSITE_CFG__;
#===============================================================================
\$TWiki::cfg{AutoAttachPubFiles} = 1;
\$TWiki::cfg{EnableHierarchicalWebs} = 1;
\$TWiki::cfg{LoginManager} = 'TWiki::Client::TemplateLogin';
\$TWiki::cfg{UserInterfaceInternationalisation} = 1;
#\$TWiki::cfg{WarningsAreErrors} = 1;
# SMELL: blech, temp hack
\$TWiki::cfg{Site}{CharSet} = 'iso-8859-15';
#===============================================================================
__LOCALSITE_CFG__

# generate LocalSite.cfg entries for variable entries (url/path,...)
foreach my $localSiteEntry ( qw( DefaultUrlHost ScriptUrlPath ScriptSuffix PubUrlPath PubDir TemplateDir DataDir LogDir LocalesDir ) ) {
    # normalise pathnames (entries ending in ...Dir) (Sandbox.pm doesn't like .. in pathnames!)
    $localDirConfig->{ $localSiteEntry } = abs_path( $localDirConfig->{ $localSiteEntry } ) 
	if $localSiteEntry =~ /Dir$/;

    $LocalSiteCfg .= qq{\$TWiki::cfg{$localSiteEntry} = "$localDirConfig->{$localSiteEntry}";\n};
}

# write out LocalSite.cfg
my $fnLocalSiteCfg = "$mapTWikiDirs->{lib}->{dest}/LocalSite.cfg";
open( FH, '>', $fnLocalSiteCfg ) or die "Can't open $fnLocalSiteCfg: $!";
print FH $LocalSiteCfg;
close( FH ) or die "Can't close $fnLocalSiteCfg: $! ???";

################################################################################
# finish/cleanup

rmtree 'tmp/';
#unlink $0;
#chmod 0440, $0;		# doesn't seem to be working??? ah, probably an ownership issue (but why does rm work?)

print $q->p( $q->a( { -href => continueToWikiUrl() }, "Proceed to the wiki" ) );

print $q->end_html;

exit 0;

################################################################################
################################################################################

# parameters
# module: module filename relative to components (eg, kernels/TWikiDEVELOP6666.zip or extension/BlogPlugin.zip)
sub InstallTWikiExtension {
    my ( $module ) = @_;

    my ( $text, $success, $plugins ) = TWiki::Contrib::TWikiInstallerContrib::_InstallTWikiExtension({ 
	module => $module,
	tmpInstall => $tmpInstall,
	mapTWikiDirs => $mapTWikiDirs,
	localDirConfig => $localDirConfig,
    });
#    print $q->li( @$text );
    foreach my $plugin ( sort keys %$plugins )
    {
	++$installedPlugins{ $plugin };
    }
#    $installedPlugins{ keys %$plugins } = values %$plugins;

    return 1;
}

################################################################################

# parameters
# cgi: 
sub twikiForMenu {
    my $q = shift or die "no cgi?";
    my $text = '';

    $text .= $q->start_form
	. $q->hidden( -name => 'force', -value => $q->param('force') )
	. 'TWikiFor: '
	. $q->textfield( -name => 'TWikiFor', -size => 50, -value => 'http://twikifor.biohack.wbniv.tenetti.org/pub/twiki.org.zip' ) 
	. $q->br
	. $q->checkbox( -name => 'customise', -label => 'Configure & select individual components' )
	. $q->br
	. $q->submit( -name => 'install', -value => 'Next...' )
	. $q->br;

    $text .= $q->end_form;

    return $text;
}

################################################################################

# parameters
# cgi: 
sub installationMenu {
    my $q = shift or die "no cgi?";
    my $text = '';

    $text .= $q->start_form
	. $q->hidden( -name => 'TWikiFor', -value => $q->param('TWikiFor') )
	. $q->hidden( -name => 'force', -value => $q->param('force') )
	. $q->submit( -name => 'install', -value => 'Install' );

    my @kernels = sort map { basename /(.*)\./ } <$tmpInstall/components/kernel/*>;
    $text .= $q->div( { -class => 'kernel', },
		      $q->checkbox_group( -name => 'kernel',
					  -values => \@kernels,
#					  -values => [ grep { m|\.| } @kernels ],
#					  -labels => { @kernels },
					  -linebreak => 'true',
					  )
		      );
    
    $text .= $q->div( { -class => 'configuration' },
		      $q->b( 'perl' ) . ' (full path): ' 
		      . $q->textfield( -name => 'perl', -default => $perl, -size => 40 )
		      . $q->br
		      . $q->small( '(may also be the name of a perl accelerator, e.g,. '
				   . $q->a( { -href => "http://www.daemoninc.com/SpeedyCGI/" }, 'SpeedyCGI' ) . ')'
				   )
		      . $q->br
		      . $q->b( 'TWikiAdmin' ) . ': '
		      . $q->textfield( -name => 'TWikiAdmin', -default => $twikiAdmin, -size => 25 )
		      . $q->br
		      . $q->b( 'WIKIWEBMASTER' ) . ': '
		      . $q->textfield( -name => 'WIKIWEBMASTER', -default => $wikiWebMaster, -size => 25 )
		      . $q->br
		      );
			    
    my @extensions = sort map { basename /(.*)\./ } <$tmpInstall/components/extension/*>;

    # do defaults creation/manipulation here, because CGI ...
    if ( grep( /^all$/i, ( $q->param('extension') ) ) ) {
	$q->param( -name => 'extension', -value => \@extensions );
    }

    $text .= $q->div( { -class => 'extension', },
		      $q->checkbox_group( -name => 'extension',
					  -values => \@extensions,
#					  -values => [ grep { m|\.| } @extensions ],
#					  -labels => { @extensions },
					  -linebreak => 'true',
					  -columns => 3,
					  )
		      );

    $text .= $q->end_form;

    return $text;
}

################################################################################

use Socket;
sub getUrl
{
    my $p = shift;

    my ( $theHost, $theUrl ) = $p->{url} =~ m|http://(.*?)(/.*)|;
    my $thePort = 80;
    my $theHeader = '';

#    print STDERR "theUrl=[$theUrl], theHost=[$theHost] thePort=[$thePort]\n";
    my $result = '';
    my $req = "GET $theUrl HTTP/1.0\r\n$theHeader\r\n\r\n";
    my ( $iaddr, $paddr, $proto );
    $iaddr   = inet_aton( $theHost );
    $paddr   = sockaddr_in( $thePort, $iaddr );
    $proto   = getprotobyname( 'tcp' );
    socket( SOCK, PF_INET, SOCK_STREAM, $proto )  or die "socket: $!";
    connect( SOCK, $paddr ) or die "connect: $!";
    select SOCK; $| = 1;
    print SOCK $req;
    while( <SOCK> ) { $result .= $_; }
    close( SOCK )  or die "close: $!";
    select STDOUT;
    return ( $result, 0 );
}

################################################################################

# url: 
#use LWP::UserAgent;
#use HTTP::Request;
#use HTTP::Response;
#sub getUrl {
#    my ( $p ) = @_;
#    my $url = $p->{url} or die qq{required parameter "url" not specified};
#
#    my $ua = LWP::UserAgent->new() or die $!;
#    $ua->agent( "TWiki remote installer v0.0.1" );
#    my $req = HTTP::Request->new( GET => $url );
#    # TODO: what about http vs. https ?
#    die unless $req;
#    $req->referer( "$ENV{SERVER_NAME}:$ENV{SERVER_PORT}$ENV{SCRIPT_NAME}" );
#    my $response = $ua->request($req);
#    die if $response->is_error();
#
#    return $response->is_error() ? ( undef, $response->status_line ) : ( $response->content(), '' );
#}

################################################################################
################################################################################
# WARNING: ../TWikiInstallerContrib.pm gets appended to the end of this file,
#          so don't do anything silly like __DATA__ or __END__ blocks :)
################################################################################
################################################################################
#!/usr/bin/perl -w
# $Id: install_twiki.cgi 7202 2005-10-28 20:36:14Z WillNorris $
# Copyright 2004,2005 Will Norris.  All Rights Reserved.
# License: GPL
use strict;
++$|;

package TWiki::Contrib::TWikiInstallerContrib;

use vars qw( $VERSION );
$VERSION = '$Rev$';

################################################################################
use File::Path qw( mkpath rmtree );
use CGI qw( :standard );
use FindBin;
use CGI::Carp qw( fatalsToBrowser );
use File::Copy qw( cp mv );
use File::Basename qw( basename );
use English;
use Scalar::Util qw( tainted );
use Data::Dumper qw( Dumper );
#use Archive::Zip;
################################################################################

# parameters
# module: module filename relative to components (eg, kernels/TWikiDEVELOP6666.zip or extension/BlogPlugin.zip)
sub _InstallTWikiExtension {
    my ( $p ) = @_;
    my $tmpInstall = $p->{tmpInstall} or die "tmpInstall";
    my $module = $p->{module} or die "module";
    my $mapTWikiDirs = $p->{mapTWikiDirs} or die "mapTWikiDirs";
    my $localDirConfig = $p->{localDirConfig} or die "localDirConfig";
    my $perl = $p->{perl} || $EXECUTABLE_NAME;

    my $plugins = {};
    my @text;

    my $INSTALL = "$tmpInstall/INSTALL/";
    $INSTALL =~ /(.*)/;
    $INSTALL = $1;
    die "INSTALL still tainted" if tainted $INSTALL;
    -d $INSTALL && rmtree $INSTALL;
    mkpath $INSTALL;

    die "module tainted" if tainted $module;

    my ( $name ) = ( basename $module ) =~ /(.*)\./;
    die "name is tainted" if tainted $name;

    print STDERR "TWikiInstallerContrib: Installing $name\n";
    my $q = CGI->new() or die $!;
    push @text, $q->b( $name );

#    $ENV{TMPDIR} =~ /(.*)/;
#    $ENV{TMPDIR} = $1;

    my $archive = Archive::Zip::CommandLine->new( $module ) 
	or warn qq{Archive::Zip::CommandLine new failed [$module] - can't install "$name"}, return 0;
    $archive->extractTree( '', $INSTALL );

    foreach my $file ( $archive->memberNames ) {
	# TODO: rename $base to something more descriptive (like ...?)
	next unless my ($path,$base) = $file =~ m|^([^/]+)(/.*)$|;

	my $map = $mapTWikiDirs->{$path} or warn "no mapping for [$path]", next;
	my $dirDest = $map->{dest} or die "no destination directory for [$path] " . Dumper( $map );

	# handle directories (path ends with /?, if so, mirror directory structure)
	mkpath( "$dirDest/$base" ), next if $base =~ m|/$|;

	push @text, $file;

	# install the file by moving it from the staging area
	my $destFile = "$dirDest/$base";
	mv( "$INSTALL/$file", $destFile ) or warn "$INSTALL/$file -> $destFile: $!";
	chmod $map->{perms}, $destFile if $map->{perms};

	# only Plugins have to be enabled (i.e., Contribs and Skins are "always on")
	if ( my ( $plugin ) = $file =~ m|^lib/TWiki/Plugins/(.+Plugin).pm$| ) {
	    ++$plugins->{$plugin};
	}

	# semi-KLUDGEy implementation to support ScriptSuffix
	if ( $path eq 'bin' && $base !~ /\./ ) {		# process extension-less files
	    my $origFile = $destFile;
	    $destFile .= $localDirConfig->{ScriptSuffix};
	    mv( $origFile, $destFile ) or die "$origFile -> $destFile: $!";

	    # TODO: use an exception here!!!
	    # patch perl path for local installation
	    local $/ = undef;
	    open( BIN, '<', $destFile ) or warn "unable to change perl path for $destFile: $!", next;
	    my $bin = <BIN>;
	    close BIN;
	    $bin =~ s|/usr/bin/perl|$perl|;

	    open( BIN, '>', $destFile ) or warn "unable to change perl path for $destFile: $!", next;
	    print BIN $bin;
	    close BIN;
	}
    }

    rmtree $INSTALL;

    return ( \@text, 1, $plugins );
}

################################################################################
################################################################################
package Archive::Zip::CommandLine;

use constant AZ_OK           => 0;
use constant AZ_ERROR        => 2;

sub new
{
    my $class = shift;
    my $self = bless( {
	'fileName'                    => ''
	},
		      $class
		      );
#    $self->{'members'} = [];
    if (@_)
    {
	my $status = $self->read(@_);
	return $status == AZ_OK ? $self : undef;
    }
    return $self;
}

sub read
{
    my ( $self, $filename ) = @_;
    $self->{fileName} = Cwd::abs_path( $filename );
    return
	-e $filename
	? AZ_OK
	: AZ_ERROR;
}

sub extractTree
{
    my ( $self, undef, $tmpInstall ) = @_;

    $self->{extractedDir} = $tmpInstall;
    system( 'unzip', '-qq', $self->{fileName}, '-d' => $self->{extractedDir} );
}

sub memberNames
{
    my ( $self ) = @_;
    chomp( my @a = grep { !/^\.$/ } `cd $self->{extractedDir}; find .` );
    @a = map { $_ .= '/' if -d "$self->{extractedDir}/$_"; $_ } @a;
    @a = map { s|^(\./)||; $_ } @a;
    return @a;
}

################################################################################

1;