path: root/rpmbuildupdate

#!/usr/bin/perl -w
#
# rpmbuildupdate by Julien Danjou
#
# Copyright (c) 2003-2004 by MandrakeSoft
#
# Permission to use, copy, modify, and distribute this software and its
# documentation under the terms of the GNU General Public License is hereby 
# granted. No representations are made about the suitability of this software 
# for any purpose. It is provided "as is" without express or implied warranty.
# See the GNU General Public License for more details.
#
# $Id$

# TODO
# do not hardcode sudo urpmi command ( to use --deps on cluster )

use strict;
use AppConfig;


my %config;

sub system_die
{
    my ($command,$message) = @_;
    $message = "$command failed" if not $message;
    # do not forget , return value of 1 means failue in unix
    system("$command") and die "$message";
}

sub build_from_src
{
	$_ = shift;
	my $nv = shift;
	my $b;
	( $b = $_ ) =~ s!.*/!!;
	if($b =~ m|^(.*)-([^-]+)-([^-]+)\.[^\.]+\.rpm|)
	{ &build($1, $nv, $_); }
}

sub file_not_found
{
	my ($basename) = @_;
	( ! -f $basename ) && return 1;
	# sometimes, webserver give a webpage when the file is not found, instead of letting wget fails
	# see wget http://www.wesnoth.org/files/wesnoth-0.7.1.tar.bz2 
	# So if the file is a html page, then it is a error and it should be removed.
	`file $basename` =~ /HTML/i && do { system("rm -f $basename") ; return 1 ; };
	return 0;
}

sub download
{
	my $wget = "wget -N -q";
 	my ($url)=@_;
	my $temp;
	( $temp = $url ) =~ s!.*/!!;
	print "Trying to fetch $url...\n";
	system("$wget $url;");
	-f "$temp" && ( $temp !~ /.bz2$/ ) && system_die("bzme $temp","Cannot convert $temp");  
}

sub fetch
{
    my ($url) = @_;
    # if you add a handler here, do not forget to add it to the body of build()
    return fetch_http($url) if ($url =~ m!^(ftp|https?)://! );
    return fetch_svn($url) if ($url =~ m!^svns?://! ); 
}

sub fetch_svn
{
    my ($url) = @_;
    my ($basename,$repos);
   
    ( $basename = $url ) =~ s!.*/!!;
    print $basename , "\n";
    ( $repos = $url ) =~ s|/$basename$||;
    $repos =~ s/^svn/http/;
    $basename =~ /^(.*)-([^-]*rev)(\d\d*).tar.bz2$/;
    my ( $name,$prefix,$release ) = ($1,$2,$3);
    my $dir="$ENV{TMP}/rpmbuildupdate-$$"; 
    my $current_dir=`pwd`; chomp $current_dir;
    mkdir $dir or die "Cannot create dir $dir";
    chdir $dir or die "Cannot change dir to $dir";
    system_die("svn co -r $release $repos","svn checkout failed on $repos");
    my $basedir ;
    ( $basedir = $repos ) =~ s!.*/!!;
   
    # FIXME quite inelegant, should use a dedicated cpan module.
    my $complete_name = "$name-$prefix$release";
    system_die("mv $basedir $complete_name");
    system_die("find $complete_name -name '.svn' | xargs rm -Rf");
    system_die("tar -cjf $complete_name.tar.bz2 $complete_name", "tar failed");
    system_die("mv -f $complete_name.tar.bz2 $current_dir");
    chdir $current_dir;
}

sub fetch_http
{
    my ($url) = @_;
    my $basename;
    ( $basename = $url ) =~ s!.*/!!;
    my $turl;

    system("rm -f $basename") if ($config{nobuild});
    
    download($url);
    foreach ('.tar.gz' , '.tgz' , '.zip' )
    { 
	    ($turl = $url) =~ s/\.tar\.bz2/$_/;
	    download($turl) if (file_not_found($basename));
    }
   
    return ! file_not_found($basename);
}

sub build
{
	my $pkg = shift;
	my $newversion = shift;
	my $pkgrpm = shift;
	my $rpm;
	
	my $found = 0;
	my ($version, $release);
	my ($spec, @url, @rpms, %specvars);

	my $top = $config{top} || `rpm --eval '%_topdir'`;
	chomp($top);
	chdir("$top/SOURCES") or die "Unable to chdir to $top/SOURCES";

	$rpm =  qq(rpm --define  "_topdir $top");
	
	print "===> Building $pkg $newversion\n";
	
	my $pkge = $pkg;
	$pkge =~ s/\+/\\\+/;
	
	# Search for file if we do not use --src
	if(!$config{src})
	{
		opendir(MP, $config{srpms}) or die "$config{srpms} is not a directory";
		@rpms = readdir(MP);

		foreach (@rpms) 
		{
			if(m|^($pkge)-([^-]+)-([^-]+)\.[^\.]+\.rpm|)
			{ $pkgrpm = $_; $version = $2; $release = $3; $found = 1; last;}
		}
		
		closedir(MP);
		
		if($found == 0) { print "Package $pkg has no source, skipping.\n\n"; return; }
	}
	else
	{
		my $pkgrpm_basename;
    		( $pkgrpm_basename = $pkgrpm ) =~ s!.*/!!;
		if($pkgrpm_basename =~ m|^($pkge)-([^-]+)-([^-]+)\.[^\.]+\.rpm|)
		{ $version = $2; $release = $3; $found = 1;}
	}

	if($config{deps})
	{
		print("sudo /usr/sbin/urpmi --auto --force ".$config{srpms}."/".$pkgrpm);
		wait;
	}
	
	if($config{src})
	{
		system_die("$rpm -ivh $pkgrpm");
		wait;
	}
	elsif(!$config{nosource})
	{
		system_die("/usr/sbin/urpmi --install-src --force ".$config{srpms}."/".$pkgrpm);
		wait;
	}

	$found = 0;

	if(!open(SPECFILE, "../SPECS/".$pkg.".spec"))
	{
		print STDERR "Unable to open spec file !\n";
		return;
	}

	while(<SPECFILE>)
	{
		# Doing a s/// version
		s/\%define\s+version\s+$version/\%define version $newversion/g;
		s/Version:\s+$version/Version: $newversion/g;
		
		$spec .= $_;
		$spec =~ s/\%define(\s+)release(\s+)(.*)/\%define release $config{release}/;
		$spec =~ s/Release\s*:(\s+)(\S*mdk)/Release:$1$config{release}/;
		push(@url, $2) if(/(Source[0-9]*)\s*:\s+((?:ftp|svns?|https?):\S+)/i);
		
		# For %vars !
		$specvars{$1} = $2 if(/\%define\s+(\S+?)\s+(\S+)/g);
		$specvars{version} = $1 if(!$specvars{version} && /Version\s*:\s+(\S+)/gi);
		$specvars{name} = $1 if(!$specvars{name} && /Name\s*:\s+(\S+)/gi);

		if(/\%changelog/)
		{
			my $email;
			my @l = getpwuid($<);
			$email = $ENV{EMAIL} ? $l[6]." <$ENV{EMAIL}>" : $l[6]." <$l[0]\@mandrakesoft.com>";
			$spec .= "* ".`LC_TIME=C date '+%a %b %e %Y'|tr -d '\n'`." ".$email.
					" ".$newversion."-".$config{release}."\n";
			$spec .= "- New release $newversion\n\n";
		}
	}
	close(SPECFILE);


	if(!$url[0])
	{ print "URL was not found ! Skipping...\n"; return; }
	
	$found = 0;
	
	foreach (@url)
	{
		# Replace variable from spec (%blabla)
		while(/\%/)
		{
		    s/\%\{(.*?)\}/$specvars{$1}/g;
		    s/\%(\w+)/$specvars{$1}/g;
		    s/\%\{name\}/$pkg/gi;
		    s/\%\{version\}/$newversion/gi;
		}

		my $basename;
		($basename=$_)=~ s!.*/!!;

		system("rm -f ${top}/SOURCES/$basename") if ($config{nobuild});
		
		# GNOME: add the major version to the URL automatically
		# for example: ftp://ftp://ftp.gnome.org/pub/GNOME/sources/ORbit2/ORbit2-2.10.0.tar.bz2
		# is rewritten in ftp://ftp.gnome.org/pub/GNOME/sources/ORbit2/2.10/ORbit2-2.10.0.tar.bz2
		if (m!ftp.gnome.org/pub/GNOME/sources/!)
		{
		    (my $major = $newversion) =~ s/([^.]+\.[^.]+).*/$1/;
		    s!(.*/)(.*)!$1$major/$2!;
		}
		
		# download from Fedora rpms
		if(/ftp\.redhat\.com/)
		{
			opendir(MP, $config{fedora}) or die "$config{fedora} is not a directory";
			my @rpmsrh = readdir(MP);
			
			my $pkgrpmrh;
			foreach (@rpmsrh) 
			{
				if(m|^($pkge)-([^-]+)-([^-]+)\.[^\.]+\.rpm|)
				{ $pkgrpmrh = $_; last;}
			}
			
			closedir(MP);

			print "Trying from fedora($basename): $config{fedora}/$pkgrpmrh\n";
			system_die("cd ${top}/SOURCES; rpm2cpio $config{fedora}/$pkgrpmrh | cpio -id $basename","Rpm extraction failed");
			wait;

			if (! -f "${top}/SOURCES/$basename")
			{
			    (my $bname = $basename) =~ s/bz2/gz/;
			    print "Trying from fedora($bname): $config{fedora}/$pkgrpmrh\n";
			    system("cd ${top}/SOURCES; rpm2cpio $config{fedora}/$pkgrpmrh | cpio -id $bname; bzme $bname","rpm recompression failed");
			    wait;
			}
		}
		# download from sourceforge mirrors
		if (m!http://prdownloads.sourceforge.net!)
		{
		    foreach my $site ("http://heanet.dl.sourceforge.net/sourceforge/",
				      "http://aleron.dl.sourceforge.net/sourceforge/",
				      "http://keihanna.dl.sourceforge.net/sourceforge/",
				      "http://belnet.dl.sourceforge.net/sourceforge/",
				      "http://unc.dl.sourceforge.net/sourceforge/",
				      "http://twtelecom.dl.sourceforge.net/sourceforge/",
				      )
		    {
			(my $dest = $_) =~ s!http://prdownloads.sourceforge.net/!$site!;
			last if (fetch_http($dest));
		    }
		}
		# download specified url
		if (! -f "${top}/SOURCES/$basename")
		{
		    fetch($_);
		}

		$found++ if(-e $basename);
	}
	
	open(SPECFILE, ">../SPECS/".$pkg.".spec") or die "Unable to open $pkg.spec";
	print SPECFILE $spec;
	close(SPECFILE);


	if(!$found)
	{
	    print "Unable to download file: URL is not valid ! :-(\n\n";
	    return;
	} elsif ($config{nobuild}) {
	    print "All files downloaded\n";
	    return;
	}
	
	if(system("$rpm -ba ../SPECS/".$pkg.".spec"))
	{
		wait;
		print "Binary build fails: building source only\n";
		system("$rpm -bs --nodeps ../SPECS/".$pkg.".spec");
	}
	wait;
}

sub wget_check
{
	my $wgetv = `wget --version`;
	$wgetv =~ /Wget/ or die "You need `wget' binary for FTP/HTTP download\n";
}

sub parse_argv
{
	my $conf = AppConfig->new({ CASE => 1 });
	
	$conf->define("rpmmon",
								{	ARGS => "=s",
									ALIAS => "r",
									ARGCOUNT => AppConfig::ARGCOUNT_ONE	}
								);

	$conf->define("release",
								{	ARGS => "=s",
									ALIAS => "l",
									DEFAULT => "1mdk",
									ARGCOUNT => AppConfig::ARGCOUNT_ONE	}
								);

	$conf->define("srpms",
								{	ARGS => "=s",
									ALIAS => "m",
									DEFAULT => "/mnt/BIG/distrib/cooker/SRPMS/",
									ARGCOUNT => AppConfig::ARGCOUNT_ONE	}
								);

	$conf->define("src",
								{	ARGS => "=s",
									ALIAS => "s",
									ARGCOUNT => AppConfig::ARGCOUNT_ONE	}
								);

	$conf->define("fedora",
								{	ARGS => "=s",
									ALIAS => "h",
									DEFAULT => "/mnt/BIG/distrib/fedora/development/SRPMS/",
									ARGCOUNT => AppConfig::ARGCOUNT_ONE	}
								);

	$conf->define("deps",
								{	ALIAS => "d",
									DEFAULT => 0,
									ARGCOUNT => AppConfig::ARGCOUNT_NONE }
								);

	$conf->define("nosource",
								{	ALIAS => "n",
									DEFAULT => 0,
									ARGCOUNT => AppConfig::ARGCOUNT_NONE	}
								);
	
	$conf->define("top",
								{	ARGS => "=t",
									ALIAS => "h",
									DEFAULT => 0,
									ARGCOUNT => AppConfig::ARGCOUNT_ONE	}
								);
	$conf->define("nobuild",
								{	ALIAS => "c",
									DEFAULT => 0,
									ARGCOUNT => AppConfig::ARGCOUNT_NONE	}
								);

	$conf->args();
	$config{rpmmon} = $conf->get("rpmmon");
	$config{deps} = $conf->get("deps");
	$config{srpms} = $conf->get("srpms");
	$config{src} = $conf->get("src");
	$config{release} = $conf->get("release");
	$config{nosource} = $conf->get("nosource");
	$config{fedora} = $conf->get("fedora");
	$config{top} = $conf->get("top");
	$config{nobuild} = $conf->get("nobuild");

}

sub usage
{
	print "rpmbuildupdate v0.4 helps you build up to date RPMs.\n\n";
	print "By Julien Danjou\n";
	print "Copyright (c) 2003-2004 by MandrakeSoft.\n";
	print "This is free software under the GPL License.\n";
	print "Usage: rpmbuildupdate [options] [pkg] [newversion]\n\n";

	print " --rpmmon <file>: parse output of rpmmon from file\n";
	print " --srpms <path_to_srpms>: specify SRPMS path\n";
	print " --src <src.rpm file> <new version>: build new version from this source RPM\n";
	print " --release <mdk_release>: release version of package (default: 1mdk)\n";
	print " --deps: install builds dependencies\n";
	print " --nosource: do not install source from (urpmi x.src.rpm)\n";
	print " --top <dir>: specify rpm top dir (default: `rpm --eval %_topdir`)\n";
	print " --nobuild|-c: do not build the package. Only download files.\n";
	exit 0;
}

sub parse_rpmmon
{
	my $f;
	($f = shift());
	-f $f or die "Error: $f is not a file.\n";
	
	open(RPMMON, $f);
	while(<RPMMON>)
	{
		&build($1, $3) if(/^\s+(\S+)\s+(\S+)\s+(\S+)$/ && ! /Package/); 
		&build($2, $4) if(/^(\S+)\s+(\S+)\s+(\S+)\s+(\S+)$/ && ! /Package/); 
	}
	close(RPMMON);
}

sub check_dir
{
	$_ = shift;
	-d $_ or die $_." is not a directory.\n";
}

sub main
{
	&parse_argv;

	&wget_check;
	
	if($config{rpmmon})
	{
		print($config{srpms});
		&parse_rpmmon($config{rpmmon});
	}
	elsif($config{src} && $ARGV[0])
	{ &build_from_src($config{src}, $ARGV[0]); }
	elsif($ARGV[0] && $ARGV[1])
	{ 
		&check_dir($config{srpms});
		&build($ARGV[0], $ARGV[1]);
	}
	else
	{ &usage; }

}

&main;