source: branches/lib/SOURCE_TOOLS/build_info.pl

Last change on this file was 18914, checked in by westram, 4 years ago
  • fix error handling for piped commands in perl
    • when forking piped commands
      • use error message ($!) instead of exitcode ($?).
      • use message 'failed to fork'.
    • when closing piped commands
      • show IPC errors and exitcode of command.
  • Property svn:executable set to *
File size: 15.1 KB
Line 
1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
6# create/update build info into
7#     ../TEMPLATES/arb_build.h
8#     ../TEMPLATES/svn_revision.h
9# and
10#     ../lib/revision_info.txt
11
12# --------------------------------------------------------------------------------
13
14my $dumpFiles = 1;
15
16my $RC_BRANCH     = 'rc';
17my $STABLE_BRANCH = 'stable';
18
19# --------------------------------------------------------------------------------
20
21my $ARBHOME = $ENV{ARBHOME};
22if (not defined $ARBHOME) { die "ARBHOME undefined"; }
23if ((not -d $ARBHOME) or (not -f $ARBHOME.'/arb_LICENSE.txt')) {
24  die "ARBHOME ('$ARBHOME') must point to ARB build directory";
25}
26
27my $TEMPLATES    = $ARBHOME.'/TEMPLATES';       if (not -d $TEMPLATES)    { die "no such directory '$TEMPLATES'"; }
28my $SOURCE_TOOLS = $ARBHOME.'/SOURCE_TOOLS';    if (not -d $SOURCE_TOOLS) { die "no such directory '$SOURCE_TOOLS'"; }
29my $lib          = $ARBHOME.'/lib';             if (not -d $lib)          { die "no such directory '$lib'"; }
30my $mv_if_diff   = $SOURCE_TOOLS.'/mv_if_diff'; if (not -x $mv_if_diff)   { die "no such script '$mv_if_diff'"; }
31
32# upgrade version?
33my $inc_major = $SOURCE_TOOLS.'/inc_major.stamp';
34my $inc_minor = $SOURCE_TOOLS.'/inc_minor.stamp';
35my $inc_candi = $SOURCE_TOOLS.'/inc_candi.stamp';
36my $inc_patch = $SOURCE_TOOLS.'/inc_patch.stamp';
37
38# --------------------------------------------------------------------------------
39
40sub execAndGetFirstNonemptyLine($) {
41  my ($infocmd) = @_;
42  # returns first nonempty line from infocmd-output
43  # or undef (if output is empty)
44  # or dies (if command fails)
45
46  my $content = undef;
47  print "[executing '$infocmd']\n";
48  open(INFO,$infocmd.'|') || die "failed to fork '$infocmd' (Reason: $!)";
49 LINE: foreach (<INFO>) {
50    if ($_ ne '') {
51      chomp;
52      $content = $_;
53      last LINE;
54    }
55  }
56  close(INFO) || die "failed to execute '$infocmd' (Reason: $! exitcode=$?)";
57  if (defined $content) { print "output='$content'\n"; }
58  else { print "no output :-(\n"; }
59  return $content;
60}
61
62sub getHost() {
63  my $arbbuildhost = $ENV{ARBBUILDHOST};
64  my @hosts = ();
65  if (defined $arbbuildhost) { push @hosts, $arbbuildhost; }
66  else {
67    my $host = $ENV{HOST};
68    my $hostname = $ENV{HOSTNAME};
69
70    if (defined $host) { push @hosts, $host; }
71    if (defined $hostname) { push @hosts, $hostname; }
72  }
73  if (scalar(@hosts)==0) {
74    my $hostnameout = undef;
75    eval { $hostnameout = execAndGetFirstNonemptyLine('hostname'); };
76    if ($@) { print "Warning: buildhost is unknown ($@)\n"; }
77    if (not defined $hostnameout) { $hostnameout = 'unknown'; }
78
79    my $domainname = undef;
80    eval { $domainname = execAndGetFirstNonemptyLine('domainname'); };
81    if ($@) { print "Warning: domain is unknown ($@)\n"; $domainname = undef; }
82    if ((not defined $domainname) or ($domainname eq '(none)')) { $domainname = 'somewhere'; }
83
84    push @hosts, $hostnameout.'.'.$domainname;
85  }
86
87  @hosts = sort { length($b) <=> length($a); } @hosts; # sort longest first
88  return $hosts[0];
89}
90
91sub getUser() {
92  my $user = $ENV{ARBBUILDUSER};
93  if (not defined $user) { $user = $ENV{USER}; }
94  if (not defined $user) {
95    eval { $user = execAndGetFirstNonemptyLine('whoami'); };
96    if ($@) { print "Warning: user is unknown ($@)\n"; $user = undef; }
97  }
98  if (not defined $user) { $user = 'unknownUser'; }
99  return $user;
100}
101
102sub guessSvnBranchInsideJenkins() {
103  my $root = undef;
104  my $url = $ENV{SVN_URL}; # is set inside jenkins
105
106  if (defined $url) {
107    if ($url eq '') { $url = undef; }
108    else {
109      my $suffix = undef;
110      if ($url =~ /^(http:\/\/vc\.arb-home\.de\/(svn|readonly))\//o) {
111        $suffix = $';
112        $root = $1;
113      }
114      elsif ($url =~ /^(svn\+ssh:\/\/.*vc\.arb-home\.de\/home\/vc\/repos\/ARB)\//o) {
115        $suffix = $';
116        $root = $1;
117      }
118      if (not defined $suffix) { die "Unexpected value in SVN_URL ('$url')"; }
119      die "root unset (url='$url')" if not defined $root;
120    }
121  }
122  return ($root,$url);
123}
124
125sub getRevision() {
126  my $jrevision = $ENV{SVN_REVISION}; # is set inside jenkins
127  if (defined $jrevision and $jrevision eq '') { $jrevision = undef; }
128
129  my $revision = undef;
130  eval {
131    $revision = execAndGetFirstNonemptyLine("svnversion -c -n '$ARBHOME'");
132    if (defined $revision and $revision =~ /^2:/) { $revision = $'; }
133  };
134  if ($@) {
135    if (defined $jrevision) {
136      print "Accepting svn failure (apparently running inside jenkins)\n";
137      $revision = $jrevision;
138    }
139    else { die $@."\n"; }
140  }
141
142  if (not defined $revision) { die "Failed to detect revision number"; }
143  if (defined $jrevision) {
144    if ($jrevision ne $revision) {
145      if ($revision =~ /M/) {
146        print "------------------------------------------------------------ [svn diff]\n";
147        system('cd $ARBHOME;svn diff');
148        print "------------------------------------------------------------\n";
149      }
150      die "Conflicting revision numbers (jrevision='$jrevision', revision='$revision')";
151    }
152  }
153  return $revision;
154}
155
156sub getBranchOrTag() {
157  # returns any of
158  #   (0,trunk)
159  #   (0,branchname)
160  #   (1,tagname)
161  # or dies
162
163  my ($jroot,$jurl) = guessSvnBranchInsideJenkins();
164  my ($root,$url)   = (undef,undef);
165  eval {
166    my $infocmd = "svn info '$ARBHOME'";
167    print "[executing '$infocmd']\n";
168    open(INFO,$infocmd.'|') || die "failed to fork '$infocmd' (Reason: $!)";
169    foreach (<INFO>) {
170      chomp;
171      print "info[b]='$_'\n";
172      if (/^Repository\sRoot:\s+/o) { $root = $'; }
173      elsif (/^URL:\s+/o) { $url = $'; }
174    }
175    close(INFO) || die "failed to execute '$infocmd' (Reason: $! exitcode=$?)";
176  };
177  if ($@) {
178    if (defined $jroot and defined $jurl) {
179      print "Accepting svn failure (apparently running inside jenkins)\n";
180      ($root,$url) = ($jroot,$jurl);
181    }
182    else { die $@."\n"; }
183  }
184
185  if (not defined $root) { die "Failed to detect repository root"; }
186  if (not defined $url)  { die "Failed to detect repository URL"; }
187
188  if (defined $jroot) {
189    if (not defined $jurl)  { die "\$jroot defined, \$jurl undefined (bug in guessSvnBranchInsideJenkins?)"; }
190    if ($jroot ne $root) { die "Conflicting SVN root detection:\n1='$root'\n2='$jroot'"; }
191    if ($jurl  ne $url)  { die "Conflicting SVN url detection:\n1='$url'\n2='$jurl'"; }
192  }
193  elsif (defined $jurl) { die "\$jurl defined, \$jroot undefined (bug in guessSvnBranchInsideJenkins?)"; }
194
195  my $rootlen = length($root);
196  my $url_prefix = substr($url,0,$rootlen);
197  if ($url_prefix ne $root) { die "Expected '$url_prefix' to match '$root'"; }
198
199  my $rest = substr($url,$rootlen+1);
200  my $is_tag = 0;
201  if ($rest =~ /^branches\//) {
202    $rest = $';
203  }
204  elsif ($rest =~ /^tags\//) {
205    $rest = $';
206    $is_tag = 1;
207  }
208  return ($is_tag,$rest);
209}
210
211sub getBranchOrTagFromHeader($) {
212  my ($header) = @_;
213  open(HEADER,'<'.$header) || die "Failed to read '$header' (Reason: $!)";
214  my ($revision,$is_tag,$branch) = (undef,undef);
215  foreach (<HEADER>) {
216    chomp;
217    if (/^\#define\s+ARB_SVN_BRANCH\s+\"([^\"]+)\"/o) { $branch = $1; }
218    elsif (/^\#define\s+ARB_SVN_BRANCH_IS_TAG\s+([01])/o) { $is_tag = $1; }
219    elsif (/^\#define\s+ARB_SVN_REVISION\s+\"([^\"]+)\"/o) { $revision = $1; }
220  }
221  close(HEADER);
222
223  if (not defined $branch) { die "Failed to parse branch from $header"; }
224  if (not defined $is_tag) { die "Failed to parse is_tag from $header"; }
225  if (not defined $revision) { die "Failed to parse revision from $header"; }
226  if ($is_tag != 0 and $is_tag != 1) { die "Invalid value is_tag='$is_tag'"; }
227  return ($revision,$is_tag,$branch);
228}
229
230sub dumpFile($) {
231  my ($file) = @_;
232  print "---------------------------------------- [start $file]\n";
233  system("cat $file");
234  print "---------------------------------------- [end $file]\n";
235}
236
237sub update($\@) {
238  my ($file,$content_r) = @_;
239  my $tmp = $file.'.tmp';
240
241  open(TMP,'>'.$tmp) || die "can't write to '$tmp' (Reason: $!)";
242  foreach (@$content_r) { print TMP $_."\n"; }
243  close(TMP);
244  `$mv_if_diff '$tmp' '$file'`;
245  if ($dumpFiles) { dumpFile($file); }
246}
247
248sub file2hash($\%$) {
249  my ($file,$hash_r,$expectFile) = @_;
250  if (open(FILE,'<'.$file)) {
251    foreach (<FILE>) {
252      chomp;
253      if (/^([^=]+)=(.*)$/o) { $$hash_r{$1}=$2; }
254    }
255    close(FILE);
256  }
257  elsif ($expectFile==1) {
258    die "can't read '$file' (Reason: $!)";
259  }
260}
261
262sub hash2file(\%$) {
263  my ($hash_r,$file) = @_;
264  open(FILE,'>'.$file) or die "can't write '$file' (Reason: $!)";
265  foreach (sort keys %$hash_r) {
266    print FILE "$_=".$$hash_r{$_}."\n";
267  }
268  close(FILE);
269}
270
271# --------------------------------------------------------------------------------
272
273my $arb_build_h    = $TEMPLATES.'/arb_build.h';
274my $svn_revision_h = $TEMPLATES.'/svn_revision.h';
275my $revision_info  = $lib.'/revision_info.txt';
276
277my $in_SVN = (-d $ARBHOME.'/.svn');
278
279# update revision info?
280my ($revision,$is_tag,$branch) = (undef,undef,undef);
281if ($in_SVN) {
282  # in SVN checkout -> update revision info
283  $revision = getRevision();
284  ($is_tag,$branch) = getBranchOrTag();
285
286  # $branch = $RC_BRANCH; # @@@ fake
287  # $branch = $STABLE_BRANCH; # @@@ fake
288  # ($is_tag,$branch) = (1, 'arb-5.20.1'); # @@@ fake
289  # ($is_tag,$branch) = (1, 'arb-5.19'); # @@@ fake
290  # ($is_tag,$branch) = (1, 'evalSomething'); # @@@ fake
291  # ($is_tag,$branch) = (1, 'arb-5.20'); # @@@ fake
292  # ($is_tag,$branch) = (1, 'arb-5.20-rc1'); # @@@ fake
293  # ($is_tag,$branch) = (1, 'arb-5.20-rc2'); # @@@ fake
294
295  my @svn_revision = (
296                      '#define ARB_SVN_REVISION      "'.$revision.'"',
297                      '#define ARB_SVN_BRANCH        "'.$branch.'"',
298                      '#define ARB_SVN_BRANCH_IS_TAG '.$is_tag,
299                     );
300
301  update($svn_revision_h,@svn_revision);
302}
303else {
304  if (not -f $svn_revision_h) {
305    die "Missing file '$svn_revision_h'";
306  }
307  # use revision info as in source tarball
308  ($revision,$is_tag,$branch) = getBranchOrTagFromHeader($svn_revision_h);
309}
310
311my $date = `date '+%d.%b.%Y'`;
312chomp($date);
313my $year = undef;
314if ($date =~ /\.([^\.]+)$/o) {
315  $year = $1;
316}
317else {
318  die "error parsing year from '$date'";
319}
320
321# read version info
322my $version_info = $SOURCE_TOOLS.'/version_info';
323my %version_info = ();
324file2hash($version_info,%version_info,1);
325
326if (not defined $version_info{CANDIDATE}) { $version_info{CANDIDATE} = 1; }
327if (not defined $version_info{PATCHLEVEL}) { $version_info{PATCHLEVEL} = 0; }
328
329if (-f $inc_major or -f $inc_minor or -f $inc_candi or -f $inc_patch) { # version/rc-candidate/patchlevel upgrade requested?
330  eval {
331    print "\n";
332    if ($in_SVN) {
333      if ($is_tag==1) {
334        die "Upgrading version information not possible in tag-checkout! (tag of this WC = '$branch')";
335      }
336      if (-f $inc_candi) {
337        if ($branch ne $RC_BRANCH) {
338          die "Upgrading RC-candidate number only possible in branch '$RC_BRANCH' (you are in '$branch')";
339        }
340        my $oldRC = $version_info{CANDIDATE};
341        if (not defined $oldRC) { die "No CANDIDATE defined"; }
342        $version_info{CANDIDATE}++;
343        my $newRC = $version_info{CANDIDATE};
344        print "RC-candidate number upgraded from $oldRC to $newRC\n";
345      }
346      elsif (-f $inc_patch) {
347        if ($branch ne $STABLE_BRANCH) {
348          die "Upgrading patchlevel only possible in branch '$STABLE_BRANCH' (you are in '$branch')";
349        }
350        my $oldPL = $version_info{PATCHLEVEL};
351        if (not defined $oldPL) { die "No PATCHLEVEL defined"; }
352        $version_info{PATCHLEVEL}++;
353        my $newPL = $version_info{PATCHLEVEL};
354        print "patchlevel upgraded from $oldPL to $newPL\n";
355      }
356      else {
357        if ($is_tag==1 or $branch ne 'trunk') {
358          die "Upgrading version only possible in 'trunk' (you are in '$branch')";
359        }
360        my $oldVersion = $version_info{MAJOR}.'.'.$version_info{MINOR};
361        if (-f $inc_major) {
362          $version_info{MAJOR}++;
363          $version_info{MINOR} = 0;
364        }
365        else {
366          $version_info{MINOR}++;
367        }
368        $version_info{CANDIDATE} = 1; # first release candidate will be rc1
369        $version_info{PATCHLEVEL} = 0; # no patchlevel (yet)
370        my $newVersion = $version_info{MAJOR}.'.'.$version_info{MINOR};
371        print "Version upgraded from $oldVersion to $newVersion\n";
372      }
373
374      $version_info{last_upgrade}=time; # upgrade timestamp
375      hash2file(%version_info,$version_info);
376    }
377    else {
378      die "Upgrading version only possible in SVN WC";
379    }
380    print "\n";
381  };
382  my $failed = $@;
383
384  # always remove requests
385  -f $inc_major && unlink($inc_major);
386  -f $inc_minor && unlink($inc_minor);
387  -f $inc_candi && unlink($inc_candi);
388  -f $inc_patch && unlink($inc_patch);
389
390  if ($failed) { die "$failed\n"; }
391}
392
393# create valid svn-tag for this version
394
395my $svn_tag              = undef;
396my $short_version        = undef;
397my $always_show_revision = 1;
398
399my $orgbranch = $branch; # real branch or branch estimated from tag
400if ($is_tag==1) {
401  if ($branch =~ /^arb-[0-9]+\.[0-9]+/o) {
402    if ($branch =~ /-rc[0-9]+$/o) { $orgbranch = $RC_BRANCH; }
403    else                          { $orgbranch = $STABLE_BRANCH; }
404  }
405  else {
406    $orgbranch = 'unknown';
407  }
408}
409
410if ($orgbranch eq $STABLE_BRANCH or $orgbranch eq $RC_BRANCH) {
411  $always_show_revision = 0;
412  $svn_tag = 'arb-'.$version_info{MAJOR}.'.'.$version_info{MINOR};
413  if ($orgbranch eq $RC_BRANCH) {
414    $svn_tag .= '-rc'.$version_info{CANDIDATE};
415  }
416  else {
417    if ($version_info{PATCHLEVEL} > 0) { $svn_tag .= '.'.$version_info{PATCHLEVEL}; }
418  }
419  $short_version = $svn_tag;
420
421  if ($is_tag==1) {
422    # check real SVN-tag vs generated SVN-tag
423    if ($branch ne $svn_tag) {
424      die "Version info and SVN-branch-tag mismatch:\n".
425        "(version suggests svn-tag = '$svn_tag'\n".
426        " real             svn-tag = '$branch')";
427    }
428  }
429  print "SVN_URL='$ENV{SVN_URL}'\n";
430  print "SVN_REVISION='$ENV{SVN_REVISION}'\n";
431}
432elsif ($is_tag==1) {
433  $short_version = 'arb-special-'.$branch; # use custom tag
434}
435else {
436  $short_version = 'arb-devel';
437  if ($branch ne 'trunk') { $short_version .= '-'.$branch; }
438  $short_version .= '-'.$version_info{MAJOR}.'.'.$version_info{MINOR};
439}
440
441defined $short_version || die "expected known short_version!";
442defined $revision || die "expected known revision!";
443my $long_version  = $short_version.'.rev'.$revision;
444
445if ($always_show_revision==1) {
446  $short_version = $long_version;
447}
448
449my $ARB_64 = $ENV{ARB_64};
450if (not defined $ARB_64) {
451  my $config_makefile = $ARBHOME.'/config.makefile';
452  if (open(CONFIG, '<'.$config_makefile)) {
453    $ARB_64 = 1; # default to 64 bit -- see ../Makefile@64bit
454    foreach (<CONFIG>) {
455      if (/^\s*ARB_64\s*:=\s*([01]).*/) {
456        $ARB_64 = $1;
457      }
458    }
459    close(CONFIG);
460  }
461  else {
462    die "Either environment variable ARB_64 has to be defined or $config_makefile has to exist!";
463  }
464}
465
466if (not $ARB_64) {
467  $short_version .= '-32bit';
468  $long_version  .= '-32bit';
469}
470
471my @arb_build = (
472                 '#define ARB_VERSION            "'.$short_version.'"',
473                 '#define ARB_VERSION_DETAILED   "'.$long_version.'"',
474
475                 '#define ARB_BUILD_DATE         "'.$date.'"',
476                 '#define ARB_BUILD_YEAR         "'.$year.'"',
477
478                 '#define ARB_BUILD_HOST         "'.getHost().'"',
479                 '#define ARB_BUILD_USER         "'.getUser().'"',
480                );
481
482update($arb_build_h,@arb_build);
483
484
485my @revision_info = (
486                     $revision.'@'.$branch,
487                    );
488
489update($revision_info,@revision_info);
Note: See TracBrowser for help on using the repository browser.