#!/usr/bin/perl -w
use strict;
use LWP::UserAgent;
use Digest::MD5;
use Data::Dumper;
use IO::File;

#====== Collect Arguments ======#
die "usage: cyg2rpm.pl <mirror URL> <working dir>\n"
	if @ARGV != 2;
my $mirror = $ARGV[0];
my $work = $ARGV[1];
$mirror =~ s{/+$}{}g;
$work =~ s{/+$}{}g;

##====== Fetch a URL ======#
sub fetch_url {
	my ($url) = @_;
	print "@ Fetch $url\n";
	if ($url =~ m{^(http|ftp|rsync)://}) {
            my $ua = LWP::UserAgent->new;
	    $ua->agent("cyg2rpm");
	    my $req = HTTP::Request->new(GET => $url);
	    my $res = $ua->request($req);
	    die $res->status_line . " at $url\n"
	      if !$res->is_success;
	    return $res->content;
	} else {
	  return slurp_file($url);
	}
}

#====== Fetch setup.ini ======#
sub fetch_setup_ini {
	return fetch_url("$mirror/setup.ini");
}

#====== Process a package definition ======#
sub process_package_def {
	my ($pkg) = @_;

	for my $key (keys %$pkg) {
		if ($key =~ m/^(.*:)?(install|source)$/) {
			my ($path,$size,$md5) = split / /, $pkg->{$key}, 3;
			$pkg->{$key} = {'path'=>$path,'size'=>$size,'md5'=>$md5};
		}
		elsif ($key =~ m/^(requires|category)$/) {
			$pkg->{$key} = [ split /\s+/, $pkg->{$key} ];
		}
		elsif ($key =~ m/^(sdesc|ldesc)$/) {
			$pkg->{$key} =~ s/^"//;
			$pkg->{$key} =~ s/"$//;
		}

		if ($key =~ m/:/) {
			# For now we are disinterested in alternate versions (eg. test, prev)
			# We may change our mind one day
			delete $pkg->{$key};
		}
	}

	$pkg->{requires} = [] if !defined $pkg->{requires};
	$pkg->{sdesc} =~ s/\n/ /g if defined $pkg->{sdesc};
}

#====== Parse setup.ini =====#
sub parse_setup_ini {
	my ($setup_ini) = @_;
	my $current_package = '';
	my $in_quote = 0;
	my $packages = {};
	my $cur_pkg = {};
	my $cur_keyword = '';
	my $prefix = '';
	local ($_);
	for $_ (split /\r?\n/, $setup_ini) {
		next if m/^#|^\s*$/;

		if (m/^@ (.*)$/) {
			&process_package_def($cur_pkg);
			$packages->{$current_package} = $cur_pkg;
			$current_package = $1;
			$prefix = '';
			$cur_pkg = {};
		}
		elsif (m/^\[(.*)\]$/) {
			$prefix = "$1:";
		}
		elsif (!$in_quote) {
			die "Got:[$_]" if !m/: /;
			my ($keyword,$value) = split /: /, $_, 2;
			$cur_keyword = $prefix . $keyword;
			$cur_pkg->{$cur_keyword} = $value;
			$in_quote = 1 if $value =~ m/^[^"]*"[^"]*$/;
			$cur_pkg->{$cur_keyword} .= "\n" if $in_quote;
		}
		else {
			$cur_pkg->{$cur_keyword} .= $_;
			$in_quote = 0 if m/"/;
			$cur_pkg->{$cur_keyword} .= "\n" if $in_quote;
		}
	}
	&process_package_def($cur_pkg);
	$packages->{$current_package} = $cur_pkg;
	return $packages;
}

#====== Fetch and process setup.ini ======#
my $packages = parse_setup_ini(fetch_setup_ini);

#====== MD5 file ======#
sub md5_file {
	my ($path) = @_;
	my $fh = new IO::File "md5sum $path|";
        die "open(md5sum $path|): $!\n" if !defined $fh;
	my $l = <$fh>;
	chomp $l;
	return (split / /, $l)[0];
}

#====== Slurp file ======#
sub slurp_file {
        my ($path) = @_;
        my $fh = new IO::File $path, "r";
	if (!defined $fh) { warn "open(<$path): $!\n"; return undef; }
        local ($/);
        my $data = <$fh>;
	return $data;
}

#====== Length file ======#
sub length_file {
	my ($path) = @_;
        my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
            $atime,$mtime,$ctime,$blksize,$blocks)
        	= stat($path);
	return $size;
}

#====== Fetch a package ======#
sub fetch_package {
	my ($pkgname) = @_;
	die "No such package: $pkgname\n" if !defined $packages->{$pkgname};
	my $pkgdef = $packages->{$pkgname};

	my $destdir = $work . "/" . $pkgname . "-" . $pkgdef->{version};
	print "- Destination directory: $destdir\n";
	system("mkdir -p $destdir");
	my $dest = "$destdir/package.tar.bz2";
	my $url = $mirror . "/" . $pkgdef->{install}->{path};

	my $needsNew = 0;

	if (!-e $dest) { $needsNew = 1; }
	else {
		my $md5 = md5_file($dest);
		my $length = length_file($dest);
		if ($md5 ne $pkgdef->{install}->{md5}) {
			print "*** MD5 failed for $pkgname - retrieve again [got $md5 expect " . $pkgdef->{install}->{md5} . "]\n";
			$needsNew = 1;
		}
		elsif ($length != $pkgdef->{install}->{size}) {
			print "*** Size failed for $pkgname - retrieve again\n";
			$needsNew = 1;
		}
	}

	if ($needsNew) {
		my $stream = fetch_url($url);
		if ($stream) {
		  my $out = new IO::File $dest, "w" or die "open(>$dest): $!\n";
		  $out->print($stream);
		  $out->close;
		  die "MD5 failed for $pkgname\n"
		    if md5_file($dest) ne $pkgdef->{install}->{md5};
		  die "Size failed for $pkgname\n"
		    if length_file($dest) != $pkgdef->{install}->{size};	
		} else {
		  warn "skipping $url: $!\n";
		  return undef;
		}
	}

	my @vparts = split '-', $pkgdef->{version};
	my $over = join("_",@vparts[0..$#vparts-1]);
	my $orel = $vparts[$#vparts];


	system("mkdir -p $destdir/build");
	my $broot = `realpath $destdir/build`;
	chomp $broot;

	my $spec = new IO::File "$destdir/package.spec", "w";
	$spec->print("BuildRoot: $broot\n");
	$spec->print("Summary: " . $pkgdef->{sdesc} . "\n");
	$spec->print("Name: $pkgname\n");
	$spec->print("Version: $over\n");
	$spec->print("Release: " . $orel . "cyg\n");
	$spec->print("Packager: cyg2rpm\n");
	$spec->print("Source: $url\n");
	$spec->print("Distribution: cyg2rpm\n");
	$spec->print("Requires: " . join(", ",@{$pkgdef->{requires}}) . "\n")
		if @{$pkgdef->{requires}} > 0;
	$spec->print("Provides: /bin/sh\n")
		if $pkgname eq "bash";
	$spec->print("Group: Unknown\n");
	$spec->print("License: Unknown\n");
	$spec->print("%description\n");
	$spec->print($pkgdef->{ldesc} . "\n")
		if defined $pkgdef->{ldesc};
	$spec->print("%files\n");
	$spec->print("%verify(size md5 mode) /\n");
	$spec->print("%post\n");
	for my $f (glob("$broot/etc/postinstall/*.sh")) {
		next if $f !~ m{/([^/]+)\.sh$};
		$spec->print("/etc/postinstall/$1.sh\n");
		$spec->print("mv /etc/postinstall/$1.sh /etc/postinstall/$1.sh.done");
	}
	$spec->close;
	
	my $rpmname = "$pkgname-$over-$orel" . "cyg.cygwin.i386.rpm";
	my $needsRpm = 0;
	my $spec_md5 = md5_file("$destdir/package.spec");
	my $arc_md5 = md5_file("$destdir/package.tar.bz2");
	$needsRpm = 1 if ! -f "$work/RPMS/$rpmname";
	$needsRpm = 1 if ! -f "$destdir/rpmcache";

	if (!$needsRpm) { 
		my $rpm_md5 = md5_file("$work/RPMS/$rpmname");
		my $rpmcache = slurp_file("$destdir/rpmcache");
		$rpmcache =~ s/(\r?\n)+//g;
		my ($expect_rpm,$expect_spec,$expect_arc) = split(/ /, $rpmcache, 3);
		if ($expect_rpm ne $rpm_md5) { print "# Expected RPM MD5=$expect_rpm, got MD5=$rpm_md5\n"; $needsRpm = 1; }
                if ($expect_spec ne $spec_md5) { print "# Expected spec MD5=$expect_spec, got MD5=$spec_md5\n"; $needsRpm = 1; }
                if ($expect_arc ne $arc_md5) { print "# Expected archive MD5=$expect_arc, got MD5=$arc_md5\n"; $needsRpm = 1; }
	} 

	if ($needsRpm) {
		system("rm -rf $destdir/build");
		system("mkdir -p $destdir/build");
		system("cd $destdir/build; tar xjpf ../package.tar.bz2");
		system("cd $destdir; rpmbuild -bb package.spec");
		system("mkdir -p $work/RPMS");
		system("mv /usr/src/rpm/RPMS/i386/$rpmname $work/RPMS");

		my $rpm_md5 = md5_file("$work/RPMS/$rpmname");
		my $rpmcache = new IO::File "$destdir/rpmcache", "w";
		$rpmcache->print("$rpm_md5 $spec_md5 $arc_md5\n");
		$rpmcache->close;
	}
}

for my $pkg (keys %$packages) {
	next if $pkg eq "";
	next if !defined $packages->{$pkg}->{install};
	print "*** Processing $pkg\n";
	fetch_package($pkg);
}
