#!/usr/bin/perl -w
# Second Life Installer Manifest Generator
# Copyright (C) 2007 Dale Glass
#
# 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 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.


# This program generates a Manifest file for the SL installer, and creates
# a directory with the packaged files ready to upload.
#
# The Manifest contains the filename, MD5SUM, and a data line.
#
# The installer doesn't contain any of the files. It tries to find them on
# the user's computer, and downloads if they can't be found.

use strict;
use Digest::MD5 qw(md5_hex);
use Digest::SHA1;

use Getopt::Long;
use Cwd qw(abs_path cwd);

$| = 1;

my $CRLF    = "\015\012";
my $prevlen = 0;

my $noredist    = {}; # List of files that can't be redistributed, as a hashref
my $cwd         = cwd();
my $output_dir  = "$cwd/compressed";
my $compression = "tlz";
my $manifest    = "$cwd/Manifest";
my $directories = "$cwd/directories.nsh";
my $sldir;
my $zipfile;

my ($cmd_help, $verbose, $noredist_list);
my $ret = GetOptions("--help"          => \$cmd_help,
                     "--nodist-list=s" => \$noredist_list,
	             "--output-dir=s"  => \$output_dir,
	             "--compression=s" => \$compression,
	             "--manifest=s"    => \$manifest,
	             "--directories=s" => \$directories,
	             "--sldir=s"       => \$sldir,
	             "--zipfile=s"     => \$zipfile);

my $dir        = abs_path(shift(@ARGV));
$output_dir    = abs_path($output_dir);
$manifest      = abs_path($manifest);
$directories   = abs_path($directories);
$noredist_list = abs_path($noredist_list);
$sldir         = abs_path($sldir);

#$dir = "../newview/packaged";
$verbose = 1;




sub dbg($) {
	if ($verbose) {
		print STDERR shift;
	}
}

sub error($) {
	print STDERR shift;
	exit(1);
}

sub status($) {
	my $msg = shift;
	my $spaces = $prevlen - length($msg);
	$spaces = 0 if ( $spaces < 0 );

	dbg "\r$msg" . (" " x $spaces);

	$prevlen = length($msg);
}

#error "Can't find SecondLife*.exe in $dir" unless (-f glob("$dir/SecondLife*.exe") );

if ( $noredist_list ) {
	dbg "Reading list of non-redistributable files...\n";
	$noredist = snarf($noredist_list);
}

# NSIS file copy needs the destination directory to exist
# Here we generate a file with the commands needed to create the 
# required directory structure.
write_dirlist_file();

# Generate file list.
# Due to NSIS script language's lack of decent string functions, the
# file is generated in a format that is as easy as possible to parse.
# The current format is:
# Header:
# 	Line 1: File count
# 	Line 2: Total uncompressed size
# 	Line 3: Total compressed size
#
# Data, one repetition per file:
# 	Line 1: Filename
# 	Line 2: MD5 sum of uncompressed file, in hex
# 	Line 3: Size of uncompressed file
# 	Line 4: SHA1 sum of compressed file, in hex (for download verification)
# 	Line 5: Size of compressed file
# 	Line 6: Params
#
# The params line currently contains "default", or "noredist".
# If it contains "noredist" then the file is not redistributable, and
# even though the MD5 is listed, it can't be donwloaded from the server.
#
# Install will fail if a file with "noredist" can't be found on the user's
# computer.

dbg "Generating file list...\n";
chdir($dir);
my @list = gen_list(".", gen_files => 1);


dbg "Compressing files...\n";
dbg "Compressing...";
open(MANIFEST, "> $manifest") or die "Can't open $manifest: $!";


chdir($dir) or die "Can't change directory to $dir: $!";
my @manifest;
my $total_compressed = 0;
my $total_uncompressed = 0;

foreach my $relname (@list) {
	my $fullname = "$dir/$relname";

	status "$relname MD5 ";
	my $md5 = file_digest($fullname, 'md5');
	my $filetype = "default";
	my $store_path = "$output_dir/$relname";
	my $store_file = "$store_path/$md5";

	my $row = {};

	$row->{filename} = $relname;
	$row->{uncomp_size} = -s $relname;
	$row->{uncomp_md5}  = $md5;

	if ( exists $noredist->{$relname} ) {
		$filetype = "noredist";
		if ( -d $store_path ) {
			# If it wasn't redistributable before, but it is now,
			# remove it.
			unlink glob("$store_path/*");
			rmdir($store_path)  or die "Can't remove $store_path: $!";
		}

		$row->{comp_size} = 0;
		$row->{comp_sha1} = "";
	} else {
		status "$relname MD5 Compress";
		mkpath($store_path);
		my $compressed = file_compress($relname, $store_file);

		status "$relname MD5 Compress SHA1";
		$row->{comp_size} = -s $compressed;
		$row->{comp_sha1} = file_digest($compressed, 'sha1');
	}

	$row->{type} = $filetype;

	$total_compressed   += $row->{comp_size};
	$total_uncompressed += $row->{uncomp_size};
	push @manifest, $row;

}
status "Done.";
dbg "\n";

dbg "Generating manifest... ";
my $nl = "\x0d\x0a";
print MANIFEST scalar @manifest . ${nl}; # File count
print MANIFEST "${total_uncompressed}${nl}";
print MANIFEST "${total_compressed}${nl}";

foreach my $row (@manifest) {
	foreach my $k (qw(filename uncomp_md5 uncomp_size comp_sha1 comp_size type)) {
		die "$k is undefined" unless defined $row->{$k};
		print MANIFEST "$row->{$k}${nl}";
	}
}
close(MANIFEST);
dbg "done.\n";

dbg "Generating .zip...";

chdir($dir);
open(ZIP, "|zip -\@ $output_dir/$zipfile") or die "Can't open zip: $!";
foreach my $row (@manifest) {
	my $relname  = $row->{filename};
	my $orig_md5 = "";

	if ( -f "$sldir/$relname" ) {
		$orig_md5 = file_digest("$sldir/$relname", 'md5');
	}

	if ( ($orig_md5 ne $row->{uncomp_md5}) && -f "$relname" ) {
		dbg "Different: $relname\n";
		print ZIP "$relname\n";
	}
}

close(ZIP);

# Generates recursively a list of files, or directories, depending
# on what is passed in %args.
#
# If %args contains gen_files, generates files
# If %args contains gen_dirs, generates directories
sub gen_list {
	my ($dir, %args) = @_;
	my @ret;

	# Read directory list, remove . and .. directories.
	opendir(DIR, $dir) or die "Can't open directory $dir: $!";
	my @filelist = sort grep { !/^\.{1,2}$/ && !/^\.svn/ } readdir(DIR);
	closedir(DIR);

	foreach my $f (@filelist) {
		my $fullpath = "$dir/$f";
		
		$fullpath =~ s/^\.\///; # Remove initial './'

		if ($args{gen_files}) {
			if ( -f $fullpath ) {
				push @ret, $fullpath;
			} elsif ( -d $fullpath ) {
				push @ret, gen_list($fullpath, %args);
			}
		} elsif ( $args{gen_dirs} ) {
			if ( -d $fullpath ) {				
				push @ret, $fullpath;
				push @ret, gen_list($fullpath, %args);
			}
		}
	}
	

	return @ret;
}

sub file_digest {
	my ($file, $type) = @_;
	my $ctx;

	if ( $type eq "md5" ) {
		$ctx = new Digest::MD5;
	} elsif ( $type eq "sha1" ) {
		$ctx = new Digest::SHA1;		
	} else {
		die "Unknown digest type $type";
	}

	open(FILE, $file) or die "Can't open $file: $!";
	binmode(FILE);

	$ctx->addfile(*FILE);
	close(FILE);

	return $ctx->hexdigest;
}

# Create a path recursively
# like mkdir -p
sub mkpath {
	my ($path) = @_;
	my @dirs = split(/\//, $path);

	my $dir = "";
	foreach my $p (@dirs) {
		$dir = "${dir}${p}/";
		if ( ! -d $dir ) {
			mkdir($dir) or die "Can't create directory $dir: $!";
		}
	}
}


sub execute {
	my ($cmd, @args) = @_;
	my $ret = system($cmd, @args);
	
	if ($? == -1) {
		die "$cmd failed to execute: $!\n";
	} elsif ($? & 127) {
		die sprintf "$cmd died with signal %d, %s coredump\n",
                           ($? & 127),  ($? & 128) ? 'with' : 'without';
	} else {
		my $retval = $? >> 8;
		if ( $retval != 0 ) {
			die "$cmd exited with value $retval";
		}
	}

}

sub cygwin2win {
	my $name = shift;
	$name =~ s/^\/cygdrive\/(\w)\//$1:\\/;
	$name =~ s/\//\\/g;

	return $name;
}
sub file_compress {
	my ($file, $dest) = @_;
	if ( -f "${dest}.tmp") {
		unlink("${dest}.tmp") or die "Can't remove ${dest}.tmp: $!";
	}

	my $destfile;

	if ( $compression eq "tlz" ) {
		$destfile = "${dest}.tlz";
	} elsif ( $compression eq "lzma" ) {
		$destfile = "${dest}.lzma";
	} else {
		die "Bad compression type: $!";
	}

	my $win_destfile = $destfile;
;

	return $destfile if ( -f $destfile ); # Skip if already there


	
	if ( $^O eq "cygwin" ) {
		# Horrible hack for cygwin.
		#
		# tar gets confused by paths like c:/foo, and understands them as a remote host
		# so we convert to cygwin full path
		#
		# but, DOS tools don't understand /cygwin/drive, so we generate a windows path
		# as well.
		$destfile =~ s/^([A-Za-z]):/\/cygdrive\/$1/;

		$win_destfile =~ s/^\/cygdrive\/(\w)\//$1:\\/;
		$win_destfile =~ s/\//\\/g;

		
#		print "WIN: $win_destfile\n";
	}


	if ( $compression eq "tlz" ) {
		# Tar is run from the position of the directory to archive,
		# so that it generates the correct paths.
		chdir($dir) or die "Failed to change directory to $dir: $!";
		execute("tar", "-cf", "data.tar", $file);

		# Tar doesn't know LZMA, so we do this manually
		execute("$cwd/lzma", "e", "data.tar", $win_destfile);
		unlink("data.tar");
	} elsif ($compression eq "lzma" ) {
		chdir($dir)  or die "Failed to change directory to $dir: $!";
		my $tmp =cygwin2win( "$dir/$file" );
			
		execute("$cwd/lzma", "e", $tmp, $win_destfile);
	}

	return $destfile;
}

# Read list of filenames from disk
# Return a hash
sub snarf {
	my ($listfile) = @_;
	my $ret = {};
	open(LIST, $listfile) or die "Can't open $listfile: $!";
	my @lines = <LIST>;
	close(LIST);

	chomp @lines;

	@lines = grep { !/^#/ && !/^$/ && !/^\s+$/ } @lines; # Remove comments and empty lines

	foreach my $f (@lines) {
		dbg "\t'$f'\n";
	}
	
	map { $ret->{$_} = 1 } @lines; # Create a hash

	return $ret;
}

sub write_dirlist {
	my ($handle, $dirlist, $type) = @_;
	my $macro_name;
	my $command;

	if ( $type eq "mkdir" ) {
		$macro_name = "create_directories";
		$command    = "CreateDirectory";
	} elsif ( $type eq "rmdir" ) {
		$macro_name = "delete_directories";
		$command    = "RMDir /REBOOTOK";
	} else {
		die "Bad type: $type";
	}

	dbg "\tGenerating ${macro_name}...\n";
	print $handle "!macro ${macro_name}${CRLF}";
	foreach my $d (@$dirlist) {
		print $handle "\t${command} \"\$INSTDIR\\$d\"${CRLF}";
	}
	print $handle "!macroend${CRLF}${CRLF}";
}

sub write_dirlist_file {
	dbg "Generating directory list...\n";
	my @dirlist = gen_list($dir, gen_dirs => 1);
	my $file;

	# Strip leading path from directories, change / to \
	map { $_ = substr($_, length($dir)+1); s/\//\\/g; } @dirlist;

	open($file, "> $directories") or die "Can't open $directories: $!";
	print $file "; File automatically generated by gen_installer.pl${CRLF}";
	print $file "; Do not edit, it'll be overwritten on the next run${CRLF}${CRLF}";
	print $file "!ifndef _DIRECTORIES_NSH_${CRLF}";
	print $file "!define _DIRECTORIES_NSH_${CRLF}${CRLF}";

	write_dirlist($file, \@dirlist, "mkdir");
	write_dirlist($file, \@dirlist, "rmdir");

	print $file "!endif${CRLF}";
	close($file);
}



