#!/usr/bin/perl # # emsource -- get Debian source, create and apply emdebian patches # Copyright (C) 2007-2009 Neil Williams # # This package 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 . # # Uses config::auto for the user's preferred working directory. # use apt-get source to get the package, calls dpkg-source -x for us. # checkout the emdebian changes, if any, from: # http://buildd.emdebian.org/repos/source/target/trunk/$package/trunk/ # check for $package/ from the output of: # svn list http://buildd.emdebian.org/repos/source/target/trunk/ # if exists, checkout the patches - use debconf setting for username to commit. # ready for emdebuild which can modify the patches for the next release. use Cwd; use Config::Auto; use File::HomeDir; use File::Basename; use Text::Wrap; use Debian::DpkgCross; use Cache::Apt::Package; use Cache::Apt::Config; use Cache::Apt::Lookup; use Emdebian::Tools; use Term::ANSIColor qw(:constants); use strict; use warnings; use vars qw/$username $verbose $our_version $home $dpkg_cross_dir $cfile $workdir $package $retval $svnadd $svnlogin $progname $suite $indexchar $clog $debver $cleanup $msg $v $src $arch $autobuild $next $newversion $chrootbuild $findonly $stats $builddep $patchdir $xcontrol $machine $variant $machine_path $machine_done $dpkg_extra $svnonly $vendor /; $progname = basename($0); $our_version = &tools_version(); $verbose = 1; $cleanup = 0; $autobuild = 0; $findonly = 0; $builddep = 0; $machine_done = 0; $stats = 0; $chrootbuild = 0; $next = 0; # tracks whether debian/changelog applies cleanly $newversion = 0; $username = ""; $suite = &get_targetsuite; # svnadd == 0 if package exists in svn, 1 if files need to be added. $svnadd = 1; &read_config(); $arch = &get_architecture(); $home = File::HomeDir->my_home; $dpkg_cross_dir = &get_aptcross_dir(); sub usageversion { print(STDERR <= 1); } my $target_gnu_type = &check_cache_arch($arch); if ((not defined $arch)||($arch eq "")||(not defined $target_gnu_type)) { &usageversion; $msg = "\n$progname: Cannot determine the architecture to build"; $msg .= " and no default architecture found."; $msg .= " Please use '$progname --arch ARCH'.\n"; die RED, wrap('','',$msg), RESET, "\n"; } my $quiet = ""; $quiet = "-q" if ($verbose < 1); $package = $names[0]; &set_verbose($verbose); &set_suite($suite); my $config = &init_cache($verbose); my $val = &get_primary; &set_mirror("ftp://$val/debian") if (defined $val); # check apt-cross is up to date print CYAN, "Checking the apt-cross cache is up to date for $arch.\n", RESET if ($verbose >= 1); &check_update($verbose); # check user input and convert to a source package name if not already. $package = &check_package($package); die "\n" if ($package eq ""); ($indexchar)=split(//, $package); my $dir = $src . "-" . $v; &where_is if ($findonly > 0); &show_stats if ($stats > 0); # make this go away with libsvn-perl eventually. $msg = "$progname: please install 'subversion' before using $progname.\n"; die RED, $msg, RESET if (! -x "/usr/bin/svn"); # read emsource config file. print GREEN, "Reading the emsource config file.", RESET, "\n" if ($verbose >= 2); $workdir = &get_workdir; $workdir = "/" if ($workdir eq ""); $msg = &check_workdir($workdir); die RED, $msg, RESET if ($msg ne ""); chdir ("$workdir") if ($workdir ne "."); print CYAN, "Working directory: '" . cwd . "'\n", RESET if ($verbose >= 2); my $svndir = "${workdir}/trunk/$indexchar/$package/trunk"; chdir "${workdir}/trunk/$indexchar/$package/trunk"; if (defined $svnonly) { $msg = "Error: --check-in mode. Unable to find source for ". "$package in '$svndir'. Try 'emsource -c $package'.\n"; die RED, $msg, RESET if (not -d "$svndir"); chdir ("$svndir"); &handle_svn; exit; } $username = &get_username if ($username eq ""); # only unstable builds should be committed to SVN or uploaded. # see emsource (1) $username = "" if (($suite ne "unstable") && ($suite ne "sid")); # handle developer vs anonymous SVN access $svnlogin = "svn+ssh://" . $username . "\@buildd.emdebian.org/var/emdebian/svn/current/target/trunk/" if ($username ne ""); $svnlogin = "http://buildd.emdebian.org/repos/current/target/trunk/" if ($username eq ""); # Possible calls: # 1: Completely new build. svnadd = 1, no patch files exist locally or in SVN. # 2. Partial data exists in SVN. (if one developer has started but failed and someone else tries.) # only an empty directory tree exists in SVN. add patch files upon successful build. svnadd=0 # 3. Existing build, no fresh package upstream. abort. (patch files exist and SVN exists). svnadd=0 # 4. Existing build, new upstream package. Remove .old and restart as new. svnadd=0 # Note: do not remove .svn without also (re)moving ../trunk and using svn update! print CYAN, "Checking for existing emdebian patches\n", RESET if ($verbose >= 1); # need the login here because we don't necessarily have a working directory yet. my $svncheck = `svn --non-interactive list $svnlogin/$indexchar/ 2>/dev/null`; $svnadd = 0 if ($svncheck =~ /\Q$package\E\//); # now check out the svn, if any if ($svnadd == 0) { print CYAN, "Checking out working copies of existing emdebian patches\n", RESET if ($verbose >= 2); # existing co ignores ./trunk which is created when adding a new package # so keep all packages together. mkdir ("trunk") if (! -d "trunk"); mkdir ("trunk/$indexchar") if (! -d "trunk/$indexchar"); chdir ("trunk/$indexchar"); # create a local working copy system ("svn co --non-interactive $quiet ${svnlogin}${indexchar}/${package}"); # now change to the package trunk chdir ("$package/trunk"); } else { print GREEN, "Adding new package '$package' to emdebian SVN.\n", RESET if (($verbose >= 2) && ($username ne "")); system ("svn co --non-interactive $quiet -N ${svnlogin}"); chdir ("trunk"); system ("svn co --non-interactive $quiet -N ${svnlogin}/$indexchar"); mkdir ("$indexchar/$package"); mkdir ("$indexchar/$package/trunk"); mkdir ("$indexchar/$package/branches"); mkdir ("$indexchar/$package/tags"); system ("svn add --non-interactive $quiet $indexchar/$package") if ($username ne ""); # this doesn't ignore all built files, just the main ones # unfortunately, svn doesn't have an 'ignore-except' # whilst retaining an ability to add new files (like a new cache file). # Using propset also *replaces* existing settings, so it has to be used # here and not later. (svn isn't easy to automate sometimes.) :-( # some packages will still need manual svn propedit commands. # note that packages beginning with e have no ignore property set - needs manual intervention. system ("svn propset --non-interactive svn:ignore \"${indexchar}*\" $indexchar/$package/trunk/") if (($username ne "") && ($indexchar ne "e")); system ("svn ci --non-interactive $quiet -m \"automated $progname checkin of empty tree\" $indexchar/$package") if ($username ne ""); chdir ("$indexchar/$package/trunk"); } my $top = cwd; if ($cleanup > 0) { $dir = &catch_no_dir if(! -d "$dir"); if (! -d $dir) { print GREEN, wrap('','',"$progname: refreshing source directory ". "'$top/$dir' for $package."), RESET, "\n"; chdir ("$top"); $retval = 0; $retval = system ("apt-get source $package"); exit($retval) if ($retval != 0); } chdir ("$top/$dir"); &emcleanup($package); &prepare_pristine ($package); &apply_patches("../"); if ((defined $xcontrol) and (-f "debian/xcontrol")) { print GREEN, wrap('','',"Running emxcontrol.\n"), RESET if ($verbose >= 2); my $msg = `/usr/share/emdebian-tools/emxcontrol 1>/dev/null`; print RED, wrap('','',$msg), RESET; print GREEN, wrap('','',"Finished running emxcontrol.\n"), RESET if ($verbose >= 2); } print CYAN, wrap('','',"\nCleaned and emdebianised source tree for ". "'$package' exists at\n"), "'$top/$dir'\n", RESET; if ($autobuild > 0) { if ($builddep > 0) { print CYAN, "Installing build dependencies with apt-get\n", RESET if ($verbose >= 1); print GREEN, "Enter your sudo password if prompted.\n", RESET if ($verbose >= 2); system ("sudo apt-get -y build-dep $package"); print CYAN, "Installing cross dependencies with emdebuild -a $arch --build-dep\n", RESET if ($verbose >= 1); my $quiet = ""; $quiet = "-q" if ($verbose < 1); system ("emdebuild -a $arch $quiet --build-dep"); } print GREEN, "Attempting an automatic build: $arch $dpkg_extra\n", RESET if ($verbose >= 1); my $n = ""; # run emdebuild and die if it dies. $n="-n" if ($next > 0); my $retval = system ("$vendor emdebuild $n -a $arch $dpkg_extra"); # if emdebuild fails, emsource -b needs to just die. $retval = $retval >> 8 if ($retval != 0); exit ($retval); } if ($chrootbuild > 0) { chdir ("$top/$dir"); print GREEN, "Attempting an automatic chroot build.\n", RESET if ($verbose >= 1); my $retval = system ("nice -n 7 sudo $vendor empdebuild --arch $arch --build $dpkg_extra"); exit (($retval >> 8)); } print CYAN, wrap('','',"Change to this directory before running 'emdebuild' or". " 'sudo $vendor empdebuild --arch $arch --build $dpkg_extra'\n"), RESET if ($verbose >= 2); print "\n"; exit(0); } print CYAN, "Checking for existing build tree in $dir.\n", RESET if ($verbose >= 2); # check first in case there is already an emdebianised build tree here. # leave it alone if it is up to date. # A refreshed Debian version will have the same source DIRECTORY so CHECK! # no source has been downloaded, yet. if ( -d "$dir") { chdir ("$dir"); $clog = `parsechangelog --format dpkg | grep Version`; $clog =~ /^Version: (.*)$/; $debver = $1; my $retver = ""; $retver = &extract_emdebversion($clog); my $msg = "\n$progname: Error. Source exists but no emdebian version found!\n"; die (RED, $msg, RESET) if ($retver eq ""); print "emdebian version = $retver\n" if ($verbose >=2); $clog =~ s/$retver//; chomp ($clog); if ($clog =~ /^Version: (.*)$/) { my $check=$1; # 1. the source directory exists, 2. the emdebian patch files exist and have been applied # 3. the Debian package is the same version as the emdebianised tree - Abort. $msg="\n$progname: $src version $check has already been emdebianised - nothing to do. "; $msg .= "Emdebianised source tree for '$package' exists at '$top/$dir' "; $msg .= "Change to this directory before running 'emdebuild'\n" if ($verbose >= 2); die (RED, wrap('','',$msg), RESET, "\n") if ("${check}$retver" eq $debver); # if we get here, the debian version does not match the emdebian version. # need to move this $dir and the emdebian patch files then start afresh. # new debian version => em1 emdebian version string. # reprepro won't complain as long as the md5sum of the .orig.tar.gz is the same. chdir ("../"); $msg = "$progname has detected a fresh Debian release: $v. The old emdebianised tree "; $msg .= "for emdebian version ${v}${retver} will be moved to ../branches/${dir} for later reference. "; $msg .= "You should delete ../branches/${dir} if it is no longer needed. It will be overwritten if "; $msg .= "$progname is called again.\n"; $msg .= "Proceeding to clean the trunk directory.\n"; print RED, wrap('', '', $msg), RESET; system ("rm -rf ${dir}.tmp") if (-d "${dir}.tmp"); system ("rm -rf ../branches/${dir}") if (-d "../branches/${dir}"); # remove the old pristine debian files, prepare for a new package. system ("rm -rf ${src}.old") if (-d "${src}.old"); system ("mv $dir ../branches/${dir}"); # With an updated upstream, any existing emdebian patch files will be overridden anyway unlink ("../emdebian-changelog.patch"); unlink ("../emdebian-control.patch"); unlink ("../emdebian-rules.patch"); # we now have a fresh location for the new tree. } else { $msg = "\n$progname: Error. Unable to compare emdebian and debian version strings!\n"; die (RED, $msg, RESET); } } # no build tree exists for the current Debian version, check for svn patches, get source then apply. chdir ("$top"); print GREEN, wrap('','',"No unpacked source directory for Debian version $v,". " getting Debian source\n"), RESET if ($verbose >= 2); $retval = system ("apt-get $quiet source $package"); exit($retval) if ($retval != 0); # catch errors where package-version does not match the unpacked directory name. $dir = &catch_no_dir if(! -d "$dir"); chdir ("$dir"); &prepare_pristine($package); # there is always a changelog patch if (-f "../emdebian-changelog.patch") { print CYAN, "Emdebianising source tree. Applying patches from SVN.\n", RESET if ($verbose >= 2); &apply_patches; opendir (PATCHES, "../") or die (RED, "Unable to open parent directory.", RESET, "\n"); # patches intended for debian/patches use the names: debian-patch-$file my @patchfiles=grep(/^debian-patch-.*$/, readdir PATCHES); closedir (PATCHES); foreach my $patch (@patchfiles) { $patch =~ s/^debian-patch-//; my $patchdir = (-d "debian/patches-applied") ? "debian/patches-applied" : "debian/patches"; mkdir $patchdir unless (-d $patchdir); open (PATCH, "../debian-patch-$patch") or warn (RED, "Cannot open debian-patch-$patch : $!", RESET, "\n"); my @p=; close (PATCH); print GREEN, "Restoring debian patch: $patch\n", RESET; open (DPATCH, ">$patchdir/$patch") or warn (RED, "Cannot write debian patch: $!", RESET, "\n"); print DPATCH @p; close (DPATCH); } } else { # Need to manage patch files that are no longer created or which are newly added. FIXME # intention is that a fresh tree - including a new upstream version needs to have em_make run. print CYAN, "Emdebianising source tree\n", RESET if ($verbose >= 2); system ("em_make $quiet --forceold --arch $arch"); } if ($svnadd == 1) { chdir("../"); if (($verbose >= 2) && ($username ne "")) { my $msg = "Placing initial emdebian patch files under SVN version control. "; $msg .= "Completed patch files can be checked into Emdebian SVN "; $msg .= " using 'emdebuild --svn' or individually using 'svn ci '.\n"; print GREEN, wrap('','', $msg), RESET; system ("svn add --non-interactive $quiet emdebian-changelog.patch emdebian-rules.patch emdebian-control.patch") if ($username ne ""); } chdir("$dir"); } print CYAN, wrap('','',"\nEmdebianised source tree for '$package' exists at '$top/$dir'\n"), RESET; print CYAN, wrap('','',"Change to this directory before running 'emdebuild' or 'sudo empdebuild --build'\n"), RESET if ($verbose >= 2); print "\n"; exit (0); sub cleanup_vers { my $t = $_[0]; return undef if (not defined($t)); $t =~ s/^[0-9]*\://; $t =~ s/\-[^-]*?$//; return $t; } sub try_patch { $patchdir = shift; my $patchfile = shift; my $reverse_sym = ""; my $reverse = 0; print CYAN, "Trying a dry-run for ${patchdir}${patchfile}\n", RESET if ($verbose >= 2); $retval = 0; $retval = system ("patch --dry-run -p1 $reverse_sym < $patchdir/$patchfile >/dev/null"); if ($retval == 256) { $reverse_sym = "-R"; $reverse = 1; } $retval = system ("patch --dry-run -p1 $reverse_sym < $patchdir/$patchfile >/dev/null"); $reverse = -1 if ($retval == 256); return $reverse; } sub check_package { &setup_config; my $pkgchk = $_[0]; my $emp = AptCrossPackage->new(); $emp->Package($pkgchk); my $apt_cross_dir = &get_cachedir; $suite = &get_targetsuite; # &use_hostsources; my $config = &init_cache($verbose); #start by downloading sources, but only if not already done this 24hrs my $mtime = (stat ("$apt_cross_dir/.aptupdate-stamp-$suite-host"))[9]; $mtime = 0 if (!defined($mtime)); my $time_now = time(); if ($time_now - $mtime > 86400) { print "Updating apt-cache for host\n" if ($verbose >= 2); &cache_update($config); utime(time, time, "$apt_cross_dir/.aptupdate-stamp-$suite-host") or ( open(F, ">$apt_cross_dir/.aptupdate-stamp-$suite-host") && close F ) } $emp = &srclookup($pkgchk); $emp = &binlookup($pkgchk) if (not defined $emp); if (defined $emp) { my $vers = $emp->{Version}; $v = &cleanup_vers($vers); $src = (defined $emp->{SourcePkg}) ? $emp->{SourcePkg} : $emp->{Package}; print CYAN, "Using $src as source package for $package ($v)\n", RESET if ($verbose >= 2); my $bins = $emp->{Binaries}; my %archlist=(); foreach my $bin_chk (@$bins) { my $bemp = AptCrossPackage->new(); $bemp->Package($bin_chk); $bemp = &lookup_pkg($bemp); next unless (defined $$bemp->Architecture); $archlist{$$bemp->Architecture}++; } warn (RED, wrap('','',"$progname: Warning. '$pkgchk' provides no packages for '$arch' " . "or '$pkgchk' could be a new package that is not yet available for '$arch'."), RESET,"\n") if (not defined ($archlist{$arch})); # ensure the source package is returned. return $src; } my $msg = "Unable to locate source for package '$_[0]' - please check the spelling of the package name. "; $msg .= "Consider using 'dpkg -S $_[0]' to identify the source package if the spelling is correct.\n"; print RED, wrap('','', $msg), RESET if ($verbose >= 1); return ""; } sub catch_no_dir { opendir(DIR, ".") or die (RED, "Cannot find or open $dir: $!", RESET); my @dirs=readdir(DIR); closedir(DIR); foreach my $f (@dirs) { if ((-d $f) && ($f =~ /^\Q$package\E/) && ($f !~ /\.old$/) && (-d "$f/debian")) { $dir = $f; } } return $dir; } sub apply_patches { $patchdir = shift; $patchdir = "../" if (not defined $patchdir); # emdebian patch files use the names: emdebian-$file.patch opendir (PATCHES, "$patchdir") or die ("Unable to open parent directory.\n"); my @patchfiles=grep(/^emdebian-.*\.patch$/, readdir PATCHES); closedir (PATCHES); foreach my $patch (sort @patchfiles) { my $reverse = &try_patch($patchdir, $patch); if ($reverse == -1) { if ($patch =~ /^emdebian-changelog.patch$/) { if ($autobuild > 0) { print GREEN, "Using 'emdebuild -n' to refresh the changelog patch\n" , RESET if ($verbose >= 2); # need to output something about the version being attempted here. $clog = `parsechangelog --format dpkg | grep Version`; $clog =~ s/^Version: (.*)$/$1/; chomp ($clog); # If the changelog patch fails to apply, assume a new version em1 print RED, "$progname: Attempted version: ${clog}em1\n", RESET; } $next = 1; } else { warn (RED, "Skipping $patch, unable to apply it.", RESET, "\n"); # flag this package as having out of date patches. system ("embug -o"); # do not autobuild if patches have failed. exit (1) if ($autobuild > 0); } next; } if ($reverse == 1) { warn (RED, "$patch has already been applied, skipping", RESET, "\n"); next; } print GREEN, "Applying $patch\n", RESET if ($verbose >= 2); $patch =~ /^emdebian-(.*)\.patch$/; my $tidy = $1; $newversion = 1 if ($patch =~ /^emdebian-changelog.patch$/); $retval = 0; $retval = system ("patch -p1 < $patchdir/$patch"); print RED, "patch reported an error for $patchdir/$patch.\n", RESET if ($retval != 0); # tidy up after the patch command. unlink "debian/$tidy.orig" if ( -f "debian/$tidy.orig"); unlink "debian/$tidy.rej" if ( -f "debian/$tidy.rej"); } # now repeat for machine variant patches return if ($machine_done > 0); &machine_variant; } sub machine_variant { # outline support for machine/variant patching. return if (not defined $machine); return if ($machine_done > 0); $variant = 'default' if (not defined $variant); # progress marker print GREEN, "Checking for customised patches for $machine:$variant\n", RESET; if (not defined $machine_path) { $workdir = &get_workdir; $workdir = "/" if ($workdir eq ""); } else { $workdir = $machine_path; } $msg = &check_workdir($workdir); die RED, $msg, RESET if ($msg ne ""); $patchdir = "${workdir}/machine/$machine/$variant/${indexchar}/${package}/"; $patchdir =~ s://:/:g; print CYAN, "Patch directory: '$patchdir'\n", RESET if ($verbose >= 2); $machine_done = 1; &apply_patches($patchdir) if (-d $patchdir); # stamp file to prevent emdebuild committing machine-specific changes # to Emdebian SVN. open (STAMP, ">../machine-patch.stamp") or die (RED,"Unable to write stamp file",RESET,".\n"); print STAMP "$machine:$variant\n"; close (STAMP); } # attempt to unwind a damaged/borked or otherwise bust emsource directory. sub emcleanup { my $cwd = cwd; print CYAN, "Cleaning $cwd:\n", RESET if ($verbose >= 1); # need to remove ../trunk and run svn update from there or barff if there is no ../trunk if (! -d "../.svn") { my $msg = "No .svn directory found, no ../../trunk/ - cannot clean up $dir for $package"; $msg .= "You may have to put the Debian source into a safe directory and "; $msg .="then remove ../../trunk before rerunning '$progname $package'."; die (RED, wrap('','',"$msg\n"), RESET) if ( ! -d "../../trunk"); } # remove the stamp file for machine_variant, if any unlink ("../machine-patch.stamp") if (-f "../machine-patch.stamp"); system ("rm -f ../emdebian*.patch"); system ("rm -f ../debian-patch*"); my $v = ($verbose >= 1) ? "" : "-q"; system ("svn update --non-interactive $v ../"); # remove .old, remove and replace source system ("rm -rf ../$package.old") if (-d "../$package.old"); chdir ("../"); system ("rm -rf ./$dir") if((-d "./$dir") && ("$dir" ne "")); $retval = system ("apt-get source $package"); exit($retval) if ($retval != 0); # in case a new upstream release has changed the directory name. $cwd = &catch_no_dir; chdir ($cwd); &prepare_pristine($package); print CYAN, "Emdebianising source tree. Applying patches from SVN.\n", RESET if ($verbose >= 2); &apply_patches("."); opendir (PATCHES, "../") or die (RED, "Unable to open parent directory.", RESET, "\n"); # patches intended for debian/patches use the names: debian-patch-$file my @patchfiles=grep(/^debian-patch-.*$/, readdir PATCHES); closedir (PATCHES); foreach my $patch (sort @patchfiles) { $patch =~ s/^debian-patch-//; mkdir "debian/patches" unless (-d "debian/patches"); open (PATCH, "../debian-patch-$patch") or warn (RED, "Cannot open debian-patch-$patch : $!", RESET, "\n"); my @p=; close (PATCH); print GREEN, "Restoring debian patch: $patch\n", RESET; open (DPATCH, ">debian/patches/$patch") or warn (RED, "Cannot write debian patch: $!", RESET, "\n"); print DPATCH @p; close (DPATCH); # add this patch to the patch series, if one is in use `echo $patch >> debian/patches/series` if (( -f "debian/patches/series" ) && ($patch !~ /^series$/)); } } sub where_is { $workdir = &get_workdir; $workdir = "/" if ($workdir eq ""); $msg = &check_workdir($workdir); die RED, $msg, RESET if ($msg ne ""); print CYAN, "Working directory: '$workdir'\n", RESET if ($verbose >= 2); my $where = "$workdir/trunk/$indexchar/$src/trunk/$dir/"; $where =~ s://:/:; if ( ! -d $where) { chdir ("$workdir/trunk/$indexchar/$src/trunk"); $dir = &catch_no_dir; $where = "$workdir/trunk/$indexchar/$src/trunk/$dir/"; $where =~ s://:/:; if ( ! -d $where) { print RED, "Cannot find '$where'.\n", RESET; print GREEN, wrap('','', "$package exists in Debian but does not appear" . " to have been built on this machine yet. Try '$progname $package'\n"), RESET if ($verbose >= 2); exit (0); } } print GREEN, "$package is located in: '$where'", RESET, "\n"; exit (0); } sub show_stats { $workdir = &get_workdir; $workdir = "/" if ($workdir eq ""); $msg = &check_workdir($workdir); die RED, $msg, RESET if ($msg ne ""); print CYAN, "Working directory: '$workdir'\n", RESET if ($verbose >= 2); my $where = "$workdir/trunk/$indexchar/$src/trunk/"; $where =~ s://:/:; if ( ! -d $where) { print RED, "Cannot find '$where'.\n", RESET; print GREEN, wrap('','', "$package exists in Debian but does not appear" . " to have been built on this machine yet. " . "Try '$progname $package'\n"), RESET if ($verbose >= 2); exit (0); } print CYAN, "Checking status of $src in $where\n", RESET if ($verbose >= 1); my $empatches = `find $where -name emdebian\\*.patch | grep -c emdebian.*\.patch`; chomp($empatches); print GREEN, "$empatches emdebian patch files\n", RESET; my $debpatches = `find $where -name debian-patch\\*.patch | grep -c debian-patch.*\.patch`; chomp($debpatches); if (($debpatches == 0) or ($debpatches > 1)) { print CYAN, "$debpatches debian patch files\n", RESET; } else { print CYAN, "$debpatches debian patch file\n", RESET; } # trunk == emdebuild pbuilder/result == empdebuild my @locations = qw: trunk pbuilder/result:; foreach my $loc (@locations) { $where = "$workdir/${loc}/$indexchar/$src/trunk/"; $where =~ s://:/:; next if (! -d $where); print CYAN, "\nChecking emdebuild status in $where\n", RESET if ($loc =~ /^trunk$/); print CYAN, "\nChecking empdebuild status\n", RESET if ($loc =~ /^pbuilder\/result$/); $where =~ s://:/:; my @all = `find "$where" -name "${src}_*_${arch}.build"`; my @embuild = `find "$where" -name "${src}_${v}*_${arch}.build"`; if (scalar @embuild == 1) { print GREEN, "build log:\n", RESET; my $state = `tail $where/${src}_${v}*_${arch}.build`; print RED, "\t${src} (${v}) FAILED to cross build for $arch.\n", RESET if ($state =~ /dpkg-buildpackage: failure/) } print GREEN, "build logs:\n", RESET if ((scalar @embuild == 0) and (scalar @all == 0)); print RED, "$package may be out of date.\n", RESET if ((scalar @embuild == 0) and (scalar @all > 0)); print GREEN, "build logs:\n", RESET if (scalar @embuild >1); foreach my $l (@embuild) { $l =~ /\Q${src}_${v}\E(.*)_${arch}.build/; my $emver = $1; $emver =~ s/^\-//; print "${where}${src}_${v}-${emver}_${arch}.build\n"; } my @emchanges = `find "$where" -name "${src}_${v}*_${arch}.changes"`; print GREEN, ".changes:\n", RESET if (@emchanges); my $latest_v = 0; my $latest_c; foreach my $l (@emchanges) { chomp($l); $l =~ /\Q${src}_${v}\E(.*)_${arch}.changes/; my $emver = $1; $emver =~ s/^\-//; my $lv = $emver; $lv =~ s/[^0-9]//g; if ($lv > $latest_v) { $latest_v = $lv; $latest_c = $l; } print "$l"; if (( -e "/usr/bin/gpg") and ($verbose >= 2)) { `gpg --verify $l 2>/dev/null`; if ( $? == 0) { print "\n"; system ("gpg --verify $l"); } else { print GREEN, " unsigned.", RESET; } } print "\n"; } if ((defined $latest_c) and ($loc eq "trunk")) { # run lintian chomp($latest_c); print GREEN, "Running lintian checks for Emdebian only.\n", RESET; print GREEN, wrap ('','',"Checking only the most recent .changes file:". " '$latest_c'\n"), RESET if ($verbose >= 2); system ("lintian --color auto -C em $latest_c"); system ("embug --lintian -p $src") if ($? != 0); print GREEN, "Finished running lintian.\n", RESET; } my @emupload = `find "$where" -name "${src}_${v}*_${arch}.upload"`; my %repository=(); print GREEN, ".upload:\n", RESET if (@emupload); foreach my $l (@emupload) { $l =~ /\Q${src}_${v}\E(.*)_${arch}.upload/; my $emver = $1; my $upcount = 0; my $upfile = "${where}${src}_${v}${emver}_${arch}.upload"; print "$upfile\n"; if ((defined $emver) and ( -f "$upfile")) { $emver =~ s/^\-//; open (UP, "$upfile"); my @repo=; close (UP); foreach my $rep (@repo) { $rep =~ /\s(\S+)\.$/; $repository{$1}++; $upcount++; } print CYAN, "$upcount files uploaded to " . join(", ", keys (%repository)); my @about = stat "$upfile"; # read the ctime of the .upload file print " on " . scalar localtime($about[10]) . " for ${v}${emver}\n", RESET; } } } if (-f "/usr/bin/emrecent") { my @where = ( "$workdir/trunk/$indexchar/$src/trunk/", "$workdir/pbuilder/result/$indexchar/$src/trunk/" ); foreach $where (@where) { $where =~ s://:/:; print CYAN, "Checking for error logs in $where", RESET,"\n"; if (-f "${where}emrecent_error.log") { open (LOG, "${where}emrecent_error.log") or die ("Cannot open error log. $!\n"); my @log=; close (LOG); print RED, @log, RESET; print GREEN, wrap('','',"If these errors have been resolved, delete ". "the '${where}emrecent_error.log' file.\n"), RESET; } } } $where = "$workdir/buildd/$indexchar/$src/trunk/"; $where =~ s://:/:; if ( -d "$where") { my $t; print CYAN, "Checking autobuilder logs in $where",RESET,"\n"; opendir (AUTO, "$where") or die ("Cannot open autobuilder log directory ($where). $!\n"); my @logs=grep(!/^\.\.?$/, readdir(AUTO)); closedir (AUTO); my $old = 0; foreach my $stamp (reverse @logs) { if ($stamp =~ /^$src-$arch-([0-9]+)\.log$/) { $t = $1 if ($1 > $old); $old = $t; } } print "${where}$src-$arch-${t}.log\n" if (defined $t); } print CYAN, "Checking bug status",RESET,"\n"; # read embug data. my $bugs = &bug_config; if (not defined $bugs->{$package}) { print GREEN, "No open cross-building bugs for $package\n", RESET; print GREEN, "Check http://bugs.debian.org/buildd.emdebian.org as well.\n", RESET; } elsif ($bugs->{$package} eq "") { print GREEN, "$package is flagged but no bug has been reported.", RESET, "\n"; } else { my $number = $bugs->{$package}; my $rr = (ref($number) eq 'ARRAY') ? join(' #', @$number) : $number; print GREEN, "$package has an open cross-building bug report: $rr\n", RESET; $rr = (ref($number) eq 'ARRAY') ? join("\nhttp://bugs.debian.org/", @$number) : $number; print GREEN, "http://bugs.debian.org/$rr\n", RESET; } my $config = &target_config(); if (defined $config->{"$package"}) { print RED, "Emdebian patches for $package are out of date.\n", RESET if ($config->{"$package"} eq "patches"); print RED, "$package FAILED to build.\n", RESET if ($config->{"$package"} eq "failed"); print RED, wrap('','',"$package is waiting for a dependency - see ". "above.\n"), RESET if ($config->{"$package"} eq "waiting"); } exit (0); } # needs to eventually use the svn perl bindings # and then be renamed. # Subroutine to handle commits and deletions of emdebian patch files for # both emdebuild and emsource. # # Patch files that have been deleted (svn status = !) are deleted # from SVN. New patch files are added. # # Unfortunately, ever time a patch file is updated, it will always # be deemed 'modified' by svn because diff outputs a timestamp as # part of the file. These changes do not need to be committed but # there is no reliable way of detecting these changes in isolation. sub handle_svn { my @patchfiles = glob ('emdebian-*-locale-*.patch'); my $locpatch = join (" ", @patchfiles); my $svndel = scalar @patchfiles; if ($svndel > 0) { print GREEN, "Removing $svndel emlocale patches\n", RESET if ($verbose >= 1); `svn -q revert ./$locpatch`; `svn -q remove ./$locpatch`; `svn -q ci -m "Automated removal of locale patches" ./$locpatch`; } # if machine_variant has been used, skip committing to SVN return if (-f "../machine-patch.stamp"); @patchfiles = (); # Include all remaining patch files. print CYAN, "Checking in emdebian patch files . . \n", RESET if ($verbose >= 1); @patchfiles = glob ('emdebian-*.patch'); my @debpatch = glob ('debian-patch*'); push @patchfiles, @debpatch; my @svnadds=(); my @svncommits=(); my @remd = `svn status . | grep !`; my @remlist=(); foreach my $f (@remd) { $f =~ s/ //g; $f =~ s/!//; chomp ($f); push @remlist, $f; } `svn -q remove @remlist` if @remlist; `svn -q ci -m "Automated removal" @remlist` if @remlist; my $status = `svn status . | grep ?`; foreach my $f (@patchfiles) { push (@svnadds, $f) if $status =~ /\Q$f\E/; } $status = `svn status .`; foreach my $f (@patchfiles) { push (@svncommits, $f) if $status =~ /\Q$f\E/; } my $addnum = scalar @svnadds; my $commitnum = scalar @svncommits; if (@svnadds) { print GREEN, "Adding $addnum patch files to SVN . . \n", RESET if ($verbose == 1); print GREEN, "Adding patch files: ", @svnadds, "\n", RESET if ($verbose >= 2); my $add = join(' ', @svnadds); system ("svn -q add $add"); } if (@svncommits) { print GREEN, "Commit $commitnum patch files into SVN . . \n", RESET if ($verbose == 1); print GREEN, "Committing patch files: ", join(' ', @svncommits), "\n", RESET if ($verbose >= 2); system ("svn ci -q -m \"automated patch file checkin\" @svncommits"); } }