Subversion Repositories Kolibri OS

Rev

Go to most recent revision | Blame | Last modification | View Log | Download | RSS feed

  1. #!/usr/bin/perl -w
  2.  
  3. use strict;
  4.  
  5. =head1
  6.  
  7. Generate a testament describing the current Git status. This gets written
  8. out in a C form which can be used to construct the NetSurf Git testament
  9. file for signon notification.
  10.  
  11. If there is no Git in place, the data is invented arbitrarily.
  12.  
  13. =cut
  14.  
  15. $ENV{LC_ALL} = 'C';
  16.  
  17. my $root = shift @ARGV;
  18. my $targetfile = shift @ARGV;
  19.  
  20. my %gitinfo; # The Git information
  21.  
  22. $root .= "/" unless ($root =~ m@/$@);
  23.  
  24. my $git_present = 0;
  25. if ( -d ".git" ) {
  26.    $git_present = 1;
  27. }
  28.  
  29. sub compat_tmpnam {
  30.    # File::Temp was introduced in Perl 5.6.1
  31.    my $have_file_tmp = eval { require File::Temp };
  32.  
  33.    if ( ! $have_file_tmp ) {
  34.      return "$$.gitt";
  35.    } else {
  36.      return File::Temp::tmpnam();
  37.    }
  38. }
  39.  
  40. sub compat_md5_hex {
  41.    # Digest::MD5 was introduced in Perl 5.7.1
  42.    my $have_digest_md5 = eval { require Digest::MD5 };
  43.    my $have_md5 = eval { require MD5 };
  44.    my $data = shift;
  45.  
  46.    if ( ! $have_digest_md5 ) {
  47.      return MD5->hexhash($data);
  48.    } else {
  49.      return Digest::MD5->new->add($data)->hexdigest;
  50.    }
  51. }
  52.  
  53. sub gather_output {
  54.    my $cmd = shift;
  55.    my $tmpfile = compat_tmpnam();
  56.    local $/ = undef();
  57.    system("$cmd > $tmpfile");
  58.    open(my $CMDH, "<", $tmpfile);
  59.    my $ret = <$CMDH>;
  60.    close($CMDH);
  61.    unlink($tmpfile);
  62.    return $ret;
  63. }
  64.  
  65. if ( $git_present ) {
  66.    my @bits = split /\s+/, `git config --get-regexp "^remote.*.url\$"`;
  67.    $gitinfo{url} = $bits[1];
  68.    chomp $gitinfo{url};
  69.    $gitinfo{revision} = `git rev-parse HEAD`;
  70.    chomp $gitinfo{revision};
  71.    $gitinfo{branch} = `git for-each-ref --format="\%(refname:short)" \$(git symbolic-ref HEAD 2>/dev/null || git show-ref -s HEAD)`;
  72.    chomp $gitinfo{branch};
  73.    @bits = split /\s+/, `git describe --tags --exact-match HEAD 2>/dev/null`;
  74.    $bits[0] = "" unless exists $bits[0];
  75.    $gitinfo{tag} = $bits[0];
  76. } else {
  77.    $gitinfo{url} = "http://nowhere/tarball/";
  78.    $gitinfo{revision} = "unknown";
  79.    $gitinfo{branch} = "tarball";
  80.    $gitinfo{tag} = "";
  81. }
  82.  
  83. my %gitstatus; # The Git status output
  84.  
  85. if ( $git_present ) {
  86.    foreach my $line (split(/\n/, gather_output("git status --porcelain"))) {
  87.       chomp $line;
  88.       my ($X, $Y, $fp) = ($line =~ /^(.)(.) (.+)$/);
  89.       my $fn = $fp;
  90.       $fn = ($fp =~ /(.+) ->/) if ($fp =~ / -> /);
  91.       next unless (care_about_file($fn));
  92.       # Normalise $X and $Y (WT and index) into a simple A/M/D etc
  93.      
  94.       $gitstatus{$fn} = "$X$Y";
  95.    }
  96. }
  97.  
  98. my %userinfo; # The information about the current user
  99.  
  100. {
  101.    my @pwent = getpwuid($<);
  102.    $userinfo{USERNAME} = $pwent[0];
  103.    my $gecos = $pwent[6];
  104.    $gecos =~ s/,.+//g;
  105.    $gecos =~ s/"/'/g;
  106.    $gecos =~ s/\\/\\\\/g;
  107.    $userinfo{GECOS} = $gecos;
  108. }
  109.  
  110. # The current date, in AmigaOS version friendly format (dd.mm.yyyy)
  111.  
  112. my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
  113. my $compiledate = sprintf("%02d.%02d.%d",$mday,$mon+1,$year+1900);
  114. chomp $compiledate;
  115.  
  116. # Spew the testament out
  117.  
  118. my $testament = "";
  119.  
  120. $testament .= "#define USERNAME \"$userinfo{USERNAME}\"\n";
  121. $testament .= "#define GECOS \"$userinfo{GECOS}\"\n";
  122.  
  123. my $qroot = $root;
  124. $qroot =~ s/"/\\"/g;
  125.  
  126. my $hostname = $ENV{HOSTNAME};
  127.  
  128. unless ( defined($hostname) && $hostname ne "") {
  129.    # Try hostname command if env-var empty
  130.    $hostname = gather_output("hostname");
  131.    chomp $hostname;
  132. }
  133.  
  134. $hostname = "unknown-host" unless (defined($hostname) && $hostname ne "");
  135. $hostname =~ s/"/\\"/g;
  136.  
  137. $testament .= "#define WT_ROOT \"$qroot\"\n";
  138. $testament .= "#define WT_HOSTNAME \"$hostname\"\n";
  139. $testament .= "#define WT_COMPILEDATE \"$compiledate\"\n";
  140.  
  141. my $cibuild = $ENV{CI_BUILD};
  142. if (defined ($cibuild) && ($cibuild ne '')) {
  143.    $testament .= "#define CI_BUILD \"$cibuild\"\n";
  144. }
  145.  
  146. $testament .= "#define WT_BRANCHPATH \"$gitinfo{branch}\"\n";
  147.  
  148. if ($gitinfo{branch} =~ m@^master$@) {
  149.    $testament .= "#define WT_BRANCHISMASTER 1\n";
  150. }
  151. if ($gitinfo{tag} =~ m@.@) {
  152.    $testament .= "#define WT_BRANCHISTAG 1\n";
  153.    $testament .= "#define WT_TAGIS \"$gitinfo{tag}\"\n";
  154. }
  155. if ($gitinfo{url} =~ m@/tarball/@) {
  156.    $testament .= "#define WT_NO_GIT 1\n";
  157. }
  158. $testament .= "#define WT_REVID \"$gitinfo{revision}\"\n";
  159. $testament .= "#define WT_MODIFIED " . scalar(keys %gitstatus) . "\n";
  160. $testament .= "#define WT_MODIFICATIONS {\\\n";
  161. my $doneone = 0;
  162. foreach my $filename (sort keys %gitstatus) {
  163.    if ($doneone) {
  164.       $testament .= ", \\\n";
  165.    }
  166.    $testament .= "  { \"$filename\", \"$gitstatus{$filename}\" }";
  167.    $doneone = 1;
  168. }
  169. $testament .= " \\\n}\n";
  170.  
  171. my $oldcsum = "";
  172. if ( -e $targetfile ) {
  173.    open(my $OLDVALUES, "<", $targetfile);
  174.    foreach my $line (readline($OLDVALUES)) {
  175.       if ($line =~ /MD5:([0-9a-f]+)/) {
  176.          $oldcsum = $1;
  177.       }
  178.    }
  179.    close($OLDVALUES);
  180. }
  181.  
  182. my $newcsum = compat_md5_hex($testament);
  183.  
  184. if ($oldcsum ne $newcsum) {
  185.    print "TESTMENT: $targetfile\n";
  186.    open(my $NEWVALUES, ">", $targetfile) or die "$!";
  187.    print $NEWVALUES "/* ", $targetfile,"\n";
  188.    print $NEWVALUES <<'EOS';
  189.  *
  190.  * Revision testament.
  191.  *
  192.  * *WARNING* this file is automatically generated by git-testament.pl
  193.  *
  194.  * Copyright 2012 NetSurf Browser Project
  195.  */
  196.  
  197. EOS
  198.  
  199.    print $NEWVALUES "#ifndef NETSURF_REVISION_TESTAMENT\n";
  200.    print $NEWVALUES "#define NETSURF_REVISION_TESTAMENT \"$newcsum\"\n\n";
  201.    print $NEWVALUES "/* Revision testament checksum:\n";
  202.    print $NEWVALUES " * MD5:", $newcsum,"\n */\n\n";
  203.    print $NEWVALUES "/* Revision testament: */\n";
  204.    print $NEWVALUES $testament;
  205.    print $NEWVALUES "\n#endif\n";
  206.    close($NEWVALUES);
  207.      foreach my $unwanted (@ARGV) {
  208.         next unless(-e $unwanted);
  209.         print "TESTAMENT: Removing $unwanted\n";
  210.         system("rm", "-f", "--", $unwanted);
  211.      }
  212. } else {
  213.    print "TESTMENT: unchanged\n";
  214. }
  215.  
  216. exit 0;
  217.  
  218. sub care_about_file {
  219.    my ($fn) = @_;
  220.    return 0 if ($fn =~ /\.d$/); # Don't care for extraneous DEP files
  221.    return 0 if ($fn =~ /\.a$/); # Don't care for extraneous archive files
  222.    return 0 if ($fn =~ /\.md5$/); # Don't care for md5sum files
  223.    return 0 if ($fn =~ /\.map$/); # Don't care for map files
  224.    return 0 if ($fn =~ /\.gitt$/); # Don't care for testament temp files
  225.    return 1;
  226. }
  227.