git.exim.org Git - buildfarm-client.git/blob

1 #!/usr/bin/perl

3 =comment

7 See accompanying License file for license details

9 =cut

11 use vars qw($VERSION); $VERSION = 'REL_0.1';

13 use strict;

14 use warnings;

15 use 5.010;

17 use Fcntl qw(:flock :seek);

18 use File::Basename;

19 use FindBin qw($RealBin);

20 use Cwd;

22 use lib $RealBin;

23 use EximBuild::Options;

25 sub branch_last_sort;

27 # Complain on old-style use (.pl extension), but only if a

28 # terminal is available.

29 if ($0 =~ /(.*)\.pl$/) {

30 die "$0: Please use `@{[join ' ' => $1, @ARGV]}' instead.\n"

31 if -t;

32 exec $1, @ARGV;

33 }

35 # Most of the client code assumes that our working directory

36 # is the client code directory.

37 chdir $RealBin or die "$0: Can't chdir to '$RealBin': $!\n";

38 say "Changed working directory to '$RealBin'" if -t;

40 my %branch_last;

41 my $run_build = './run_build';

43 my($run_all, $run_one);

44 my %extra_options =(

45 'run-all' => \$run_all,

46 'run-one' => \$run_one,

47 );

49 # process the command line

50 EximBuild::Options::fetch_options(%extra_options);

52 # no non-option args allowed here

53 die("$0: non-option arguments not permitted")

54 if @ARGV;

56 die "$0: only one of --run-all and --run-one permitted"

57 if ($run_all && $run_one);

59 die "$0: need one of --run-all and --run-one"

60 unless ($run_all || $run_one);

62 # common mistake

63 die "$0: need group searchable homedir"

64 unless (stat($ENV{HOME}) & 0550 == 0550);

66 # set up a "branch" variable for processing the config file

67 use vars qw($branch);

68 $branch = 'global';

70 #

71 # process config file

72 #

73 require $buildconf;

75 unless (

76 (

77 ref $EximBuild::conf{branches_to_build} eq 'ARRAY'

78 &&@{$EximBuild::conf{branches_to_build}}

79 )

80 ||$EximBuild::conf{branches_to_build} =~

81 /^(ALL|HEAD_PLUS_LATEST|HEAD_PLUS_LATEST2)$/

82 )

83 {

84 die "no branches_to_build specified in $buildconf";

85 }

87 my @branches;

88 if (ref $EximBuild::conf{branches_to_build})

89 {

90 @branches = @{$EximBuild::conf{branches_to_build}};

91 }

92 elsif ($EximBuild::conf{branches_to_build} =~

93 /^(ALL|HEAD_PLUS_LATEST|HEAD_PLUS_LATEST2)$/ )

94 {

96 # Need to set the path here so we make sure we pick up the right perl.

97 # It has to be the perl that the build script would choose

98 # i.e. specially *not* the MinGW SDK perl that is invoked for the

99 # build script, which means we need to put the path back the way it was

100 # when we're done

101 local $ENV{PATH} = $EximBuild::conf{build_env}->{PATH}

102 if ($EximBuild::conf{build_env}->{PATH});

103 (my $url = $EximBuild::conf{target}) =~s/cgi-bin.*/branches_of_interest.txt/;

104 my $branches_of_interest = `perl -MLWP::Simple -e "getprint(q{$url})"`;

105 die "getting branches of interest" unless $branches_of_interest;

106 push(@branches,$_)foreach (split(/\s+/,$branches_of_interest));

107 #splice(@branches,0,-2)

108 # if $EximBuild::conf{branches_to_build} eq 'HEAD_PLUS_LATEST';

109 #splice(@branches,0,-3)

110 # if $EximBuild::conf{branches_to_build} eq 'HEAD_PLUS_LATEST2';

111 }

112

113 @branches = apply_throttle(@branches);

114

115 my $global_lock_dir =

116 $EximBuild::conf{global_lock_dir}

117 ||$EximBuild::conf{build_root}

118 ||'';

119

120 unless ($global_lock_dir && -d $global_lock_dir)

121 {

122 die "no global lock directory: $global_lock_dir";

123 }

124

125 # acquire the lock

126

127 my $lockfile;

128

129 my $lockfilename = "$global_lock_dir/GLOBAL.lck";

130

131 open($lockfile, ">$lockfilename") || die "opening lockfile: $!";

132

133 if ( !flock($lockfile,LOCK_EX|LOCK_NB) )

134 {

135 print "Another process holds the lock on " ."$lockfilename. Exiting.\n"

136 if ($verbose);

137 exit(0);

138 }

139

140 if ($run_all)

141 {

142 foreach my $brnch(@branches)

143 {

144 run_branch($brnch);

145 }

146 }

147 elsif ($run_one)

148 {

149

150 # sort the branches by the order in which they last did actual work

151 # then try running them in that order until one does some work

152

153 %branch_last = map {$_ => find_last_status($_)} @branches;

154 foreach my $brnch(sort branch_last_sort @branches)

155 {

156 run_branch($brnch);

157 my $new_status = find_last_status($brnch);

158 last if $new_status != $branch_last{$brnch};

159 }

160 }

161

162 exit 0;

163

164 ##########################################################

165

166 sub run_branch

167 {

168 my $branch = shift;

169 my @args = ($run_build,EximBuild::Options::standard_option_list(), $branch);

170

171 # Explicitly use perl from the path (and not this perl, so don't use $^X)

172 # This script needs to run on Cygwin with non-cygwin perl if it's running

173 # in tandem with AS/MinGW perl, since Cygwin perl doesn't honor locks

174 # the samne way, and the global lock fails. But the build script needs

175 # to run with the native perl, even on Cygwin, which it picks up from

176 # the path. (Head exploding yet?).

177 system("perl",@args);

178 }

179

180 sub branch_last_sort

181 {

182 return $branch_last{$a} <=> $branch_last{$b};

183 }

184

185 sub find_last_status

186 {

187 my $brnch = shift;

188 my $status_file =

189 "$EximBuild::conf{build_root}/$brnch/$EximBuild::conf{animal}.last.status";

190 return 0 unless (-e $status_file);

191 my $handle;

192 open($handle,$status_file) || dir $!;

193 my $ts = <$handle>;

194 chomp $ts;

195 close($handle);

196 return $ts + 0;

197 }

198

199 sub apply_throttle

200 {

201 my @branches = @_;

202 return @branches unless exists $EximBuild::conf{throttle};

203 my @result;

204 my %throttle = %{$EximBuild::conf{throttle}};

205

206 # implement throttle keywords ALL !HEAD and !RECENT

207 my @candidates;

208 my $replacement;

209 if (exists $throttle{ALL})

210 {

211 @candidates = @branches;

212 $replacement = $throttle{ALL};

213 }

214 elsif (exists $throttle{'!HEAD'})

215 {

216 @candidates = grep { $_ ne 'HEAD' } @branches;

217 $replacement = $throttle{'!HEAD'};

218 }

219 elsif (exists $throttle{'!RECENT'})

220 {

221

222 # sort branches, make sure we get numeric major version sorting right

223 my @stable = grep { $_ ne 'HEAD' } @branches;

224 s/^REL(\d)_/0$1/ foreach (@stable);

225 @stable = sort @stable;

226 s/^REL0/REL/ foreach (@stable);

227 pop @stable; # remove latest

228 @candidates = @stable;

229 $replacement = $throttle{'!RECENT'};

230 }

231 foreach my $cand (@candidates)

232 {

233

234 # only supply this for the branch if there isn't already

235 # a throttle

236 $throttle{$cand} ||= $replacement;

237 }

238

239 # apply throttle filters

240 foreach my $branch(@branches)

241 {

242 my $this_throttle = $throttle{$branch};

243 unless (defined $this_throttle)

244 {

245 push(@result,$branch);

246 next;

247 }

248 my $minh = $this_throttle->{min_hours_since};

249 my $ts = find_last_status($branch);

250 next

251 if ( $ts

252 && (defined $minh)

253 &&($minh && $minh < ((time - $ts) / 3600.0)));

254 if (exists $this_throttle->{allowed_hours})

255 {

256 my @allowed_hours = split(/,/,$this_throttle->{allowed_hours});

257 my $hour = (localtime(time))[2];

258 next unless grep {$_ == $hour} @allowed_hours;

259 }

260 push(@result,$branch);

261 }

262

263 return @result;

264 }