From 1a6aa6695fe4004159ebdcde50aa14bc6ec5a0d3 Mon Sep 17 00:00:00 2001 From: jkratoch <> Date: Thu, 9 Jul 2009 12:42:17 +0000 Subject: [PATCH] init --- bin/hammock | 331 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 331 insertions(+) create mode 100755 bin/hammock diff --git a/bin/hammock b/bin/hammock new file mode 100755 index 0000000..d477300 --- /dev/null +++ b/bin/hammock @@ -0,0 +1,331 @@ +#! /usr/bin/perl +# $Id$ + +use strict; +use warnings; +use POSIX qw(&strftime); +use Getopt::Long; +use Carp qw(&carp); +my $start=time(); + +my $gdbcvsbare=$ENV{"HOME"}."/redhat/gdb-cvs-bare"; +my $archermaster=$ENV{"HOME"}."/redhat/master"; +my $fedoracvsroot=q{:pserver:anonymous:@cvs.fedoraproject.org:/cvs/pkgs}; +my $rhelcvsroot=q{:pserver:anonymous:@192.168.67.2:3401/cvs/dist}; +my $arch_i386=qr{(?:x86|i\d86|ia32)}io; +my $arch_x86_64=qr{(?:x8664|x86_64|em64t)}io; +my @arches=qw(i386 x86_64); +my $arches_re=qr{(?:i386|x86_64)}; + +my $error=0; +sub error +{ + carp @_; + $error++; +} + +my $userid; +my $force; +my $parallel=9; # 1 or 2 or 3 +my @distro; +my @path; +my @arch; +my $component; +my $srcrpm; +my @file; +die if !GetOptions( + "i|userid=s"=>\$userid, + "force"=>\$force, + "1|serial"=>sub { $parallel=1; }, + "2|standard"=>sub { $parallel=2; }, + "3|parallel"=>sub { $parallel=3; }, + "d|distro=s{,}"=>\@distro, + "p|path=s{,}"=>\@path, + "a|arch=s{,}"=>\@arch, + "c|component=s"=>\$component, + "s|srcrpm=s"=>\$srcrpm, + "file=s{,}"=>\@file, +); +$component and ($component=~m{^(?:(?:fedora|rhel)(?:gdb|glibc)|gdbcvs|archer-.*|/home/.*)$} or die "-c|--component required to be: fedoragdb|rhelgdb|fedoraglibc|rhelglibc|gdbcvs|archer-*|/home/*"); +$component and $component=~m{^/home/} and (-f "$component/gdb/gdbtypes.c" or die "$component/gdb/gdbtypes.c not found"); +$component and $srcrpm and die "-c|--component excludes -s|--srcrpm"; +$component or $srcrpm or die "-c|--component or -s|--srcrpm required"; +$component||=""; # Make `eq' not complaining. +for my $file (@file) { + -f $file and -r $file or error "-f|--file $file not readable: $!"; +} +# User may want to modify ASAP her files submitted for the test. +my $will_copy=@file || $component=~m{^/home/}; +$parallel||=$will_copy ? 2 : 1; +error "Excessive arguments: @ARGV" if @ARGV; +@arch=@arches if !@arch; +my $path=join(":",@path) if @path; + +# epel-\d-i386|fedora-\d-i386|fedora-rawhide-i386 +my @distrouse; +for (@distro) { + s{^/var/lib/mock/+}{}; + s{/+$}{}; + s/^.*$/\L$&/s; + s/^(?:devel|rawhide)\b/fedora-rawhide/; + s/^(?:epel|rhel|centos)-?(\d)/epel-$1/; + s/^(?:f|fedora)-?(\d)/fedora-$1/; + my @archuse; + @archuse="i386" if s/-$arch_i386$//o; + @archuse="x86_64" if s/-$arch_x86_64$//o; + @archuse=@arch if !@archuse; + for my $archuse (@archuse) { + my $basename="$_-$archuse"; + my $dir="/var/lib/mock/$basename"; + -d $dir or error "No distro: $dir"; + push @distrouse,$basename; + } +} + +sub newdir($) +{ + my($dir)=@_; + + warn "+ mkdir $dir\n"; + mkdir $dir or die "mkdir $dir: $!"; +} + +my $log; +sub spawn($) +{ + my($cmd)=@_; + + $cmd="set -ex; $cmd"; + my $ok="$log.ok" if $log; + $cmd="($cmd; touch $ok) 2>&1|tee -a $log; test -f $ok" if $log; + unlink $ok if $ok; + # warn "+ $cmd\n"; + system $cmd and die "$cmd: $!"; + unlink $ok if $ok; +} + +my $basedir=$ENV{"HOME"}."/hammock"; +-d $basedir or newdir $basedir; +my $idbase=strftime("%Y%m%d",localtime()); +my $id; +my $dir; +for my $seq (defined $userid ? $userid : (0..99)) { + $id=$idbase.(defined $userid ? $seq : sprintf("%02d",$seq)); + $dir="$basedir/$id"; + last if ! -e $dir; +} +spawn "rm -rf $dir" if -d $dir && $force && defined $userid; +error "Directory not free: $dir" if !$id || !$dir || -e $dir; +print STDERR "ID = $id | dir = $dir\n"; +error "No distros specified" if !@distrouse; +die "$error errors seen, aborted" if $error; + +spawn "renice 20 -p $$"; +newdir $dir; +$log="$dir/log"; +spawn "uname -r >$dir/kernel"; +my %dump=( + "path"=>$path, + "component"=>$component, + "srcrpm"=>$srcrpm, + "file"=>join("\n",@file), +); +while (my($name,$val)=each(%dump)) { + next if !$val; + local *F; + my $fname="$dir/$name"; + open F,">$fname" or die $fname; + print F "$val\n" or die $fname; + close F or die $fname; +} + +# PID->distro +my %child; +for my $distro (@distrouse) { + my $cvsbasedir; + my $cvsroot; + my $cvsrepo; + if ($component=~/^fedora(gdb|glibc)$/) { + $cvsrepo=$1; + $cvsbasedir="F-$1" if $distro=~/^fedora-(\d+)-$arches_re$/; + $cvsbasedir="devel" if $distro=~/^fedora-rawhide-$arches_re$/; + die "$component vs. $distro" if !$cvsbasedir; + $cvsroot=$fedoracvsroot; + } + if ($component=~/^rhel(gdb|glibc)$/) { + $cvsrepo=$1; + $cvsbasedir="RHEL-$1" if $distro=~/^epel-(\d+)-$arches_re$/; + die "$component vs. $distro" if !$cvsbasedir; + $cvsroot=$rhelcvsroot; + } + + my $distrodir="$dir/$distro"; + newdir $distrodir; + $log="$distrodir/log"; + my $out="$distrodir/out"; + + if ($parallel>1) { + my $pid=fork(); + die if !defined $pid; + if ($pid) { + $child{$pid}=$distro; + next; + } + } + + my $builddir="$distrodir/build"; + newdir $builddir; + + $::distro=$distro; + sub mockrun($) + { + my($c)=@_; + + $c="export PATH=\"$path:\$PATH\"; $c" if $path; + $c="export MAKEFLAGS=\"-j\$[`getconf _NPROCESSORS_ONLN`*3/2]\"; $c"; + $c="set -ex; cd $builddir; $c"; + die "found ': $c" if $c=~/'/; + spawn "mockrun $::distro '$c'"; + } + + mockrun "rpm -qa|sort >$distrodir/rpm-qa"; + + if ($cvsbasedir) { + die if !$cvsroot; + die if !$cvsrepo; + spawn "cd $distrodir; cvs -q -z3 -d $cvsroot co rpms/$cvsrepo/$cvsbasedir"; + my $componentdir="$distrodir/rpms/$cvsrepo/$cvsbasedir"; + -d $componentdir or die "Failed checkout to: $componentdir"; + # Required for RHEL; Fedora does so automatically. + spawn "cd $componentdir/..; cvs -q -z3 -d $cvsroot co common"; + + for my $file (@file) { + my $filebase=$file; + $filebase=~s{^.*/}{}; + my $target="$componentdir/$filebase"; + # Some *.patch files may be new. + # -f $target or die "File $file does not exist at $target"; + spawn "rm -f $target; cp -p $file $target"; + } + + my $glob="$componentdir/*.src.rpm"; + @{[glob $glob]}==0 or die "Found some before test-srpm: $glob"; + spawn "cd $componentdir; make test-srpm"; + my @srcrpm=(glob $glob); + @srcrpm==1 or die "Did not find 1 srcrpm: @srcrpm"; + $srcrpm=$srcrpm[0]; + } + + if ($srcrpm) { + my $srcrpmbasename=$srcrpm; + $srcrpmbasename=~s{^.*/}{}; + spawn "cp -p $srcrpm $builddir/$srcrpmbasename"; + + my $rpmbuildlocal=q{rpmbuild --define "_topdir $PWD" --define "_builddir $PWD" --define "_rpmdir $PWD" --define "_sourcedir $PWD" --define "_specdir $PWD" --define "_srcrpmdir $PWD" --define "_build_name_fmt %%{NAME}-%%{VERSION}-%%{RELEASE}.%%{ARCH}.rpm"}; + $rpmbuildlocal="orphanripper $rpmbuildlocal" if $cvsrepo && $cvsrepo eq "glibc"; + mockrun $rpmbuildlocal." --rebuild --with testsuite".($parallel<2 ? "" : " --with parallel")." $srcrpmbasename"; + } + + my $baretestsuite; + + if ($component eq "gdbcvs") { + if (-d $gdbcvsbare) { + spawn "cp -a $gdbcvsbare $builddir/src; cd $builddir/src; cvs update -A"; + } else { + spawn "cd $builddir; cvs -q -z3 -d :pserver:anoncvs:\@sourceware.org:/cvs/src co gdb"; + } + spawn "cd $builddir/src".q{; test -z "$(cvs update -A)"}; + $baretestsuite="$builddir/src"; + } + + if ($component=~/^archer-/) { + if (-d $archermaster) { + spawn "cp -a $archermaster $builddir/$component; cd $builddir/$component; git pull" + } else { + spawn "cd $builddir; git clone git://sourceware.org/git/archer.git; mv -f archer $component"; + } + spawn "cd $builddir/$component; git checkout -b $component origin/$component; [ \"`git status`\" = \"# On branch $component\nnothing to commit (working directory clean)\" ]"; + $baretestsuite="$builddir/$component"; + } + + if ($component=~m{^/home/}) { + spawn "cp -a $component $builddir/src; cd $builddir/src; find -name \"*.[oa]\" -o -name \"*.l[oa]\" -o -name gdb.sum -o -name gdb.log|xargs rm -f; make clean || :"; + $baretestsuite="$builddir/src"; + } + + if ($baretestsuite) { + for my $file (@file) { + my $target="$baretestsuite/$file"; + if ($file=~m{\Q.patch\E$}) { + my $fileabs=$file; + $fileabs=$ENV{"PWD"}."/$fileabs" if $fileabs!~m{^/}; + spawn "cd $baretestsuite; patch -p1 <$fileabs"; + } else { + -f $target or $file=~m{/testsuite/} or die "File $file does not exist at $target"; + spawn "rm -f $target; cp -p $file $target"; + } + } + + my @check=($distro=~/-x86_64/ ? qw(-m64 -m32) : -m32); + @check=map("check//unix/$_",@check); + # FSF GDB has no PIE support. + # @check=map({($_,"$_/-fPIE/-pie");} @check); + # for i in ".join(" ",@check).";do orphanripper make -k \$i || :;done + mockrun "cd $baretestsuite; errs1; errs2; cd gdb; ulimit -c unlimited; orphanripper make -k ".join(" ",@check)." || :; mkdir $out; ".q{for t in sum log;do for file in testsuite*/gdb.$t;do suffix="${file#testsuite.unix.}"; suffix="${suffix%/gdb.$t}"; ln $file}." $out/gdb-$distro".q{$suffix.$t || :; done; done;}; + } + + # Call gdbunpack only if no direct $out directory will be created. + # It is needed only for .src.rpm-built testsuites, no matter how .src.rpm + # got created. + if ($component=~/^(?:fedora|rhel)glibc$/) { + local *F; + open F,$log or die $log; + my $F=do { local $/; ; } or die $log; + close F or die $log; + $F=~s{^.*?\n(={20}TESTING DETAILS={17}\n.*\n={20}PLT RELOCS END={18}\n).*$}{$1}s or die "No TESTING part found: $log"; + + open F,">$out" or die $out; + print F $F or die $out; + close F or die $out; + } elsif ($cvsbasedir || $srcrpm) { + spawn "gdbunpack $log"; + } + + exit 0 if $parallel>1; +} + +while (1) { + print STDERR "waiting for ".scalar(keys(%child))." children...\n"; + my $pid=wait(); + last if $pid==-1 && $!==10; # 10==No child processes + die "wait()==-1: $!" if $pid==-1; + die "not found pid $pid" if !$child{$pid}; + error "weird status $? for pid $pid: ".$child{$pid} if $?; + print STDERR "finished: $pid ".$child{$pid}."\n"; + delete $child{$pid}; +} +die "Uncollected children: ".keys(%child) if keys(%child); + +sub timestr($) +{ + my($sec)=@_; + my $r=""; + + if ($sec>=60*60) { + $r.=int($sec/(60*60))."h"; + $sec%=60*60; + } + if ($r || $sec>=60) { + $r.=int($sec/60)."m"; + $sec%=60; + } + $r.=$sec."s"; + + return $r; +} + +print STDERR "ID = $id | dir = $dir\n"; +print STDERR "total time=".timestr(time()-$start)."\n"; +die "$error errors seen, aborted" if $error; + +print STDERR "done\n"; -- 1.8.3.1