git.gag.com Git - debian/amanda/blob - packaging/common/substitute.pl

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4 use POSIX;
   5 # Used by make to replace tags delimited by pairs of '%%'.  Each tag should be
   6 # listed below.  Remember, the script reads from the environment for $pkg_type
   7
   8 # ARGV[0] = Source file (ends in .src)
   9 # ARGV[1] = Destination file (usually ARGV[0] - ".src"
  10
  11 #### Checks
  12 # We must run from the root of a source tree, but we can only check that the
  13 # common files are in the right places
  14 if ( not -e "packaging/common/substitute.pl" ) {
  15     die "Error: 'substitute.pl' must be run from the root of a source tree"
  16 }
  17
  18 sub get_version {
  19         # Two build cases: from checkout (svn info works), or dist tarball
  20         # (FULL_VERSION will exist). First try FULL_VERSION, then
  21         # try svn info, which takes more time and processing. We assume our url
  22         # is structured something like this:
  23         # http://<server>/<project>/<trunk|branches|tags>/[<branch>|<tag>]
  24         # The re is tested on http urls with full DNS names, but ssh+svn:// or
  25         # file:/// and short DNS names should work too.
  26
  27         my $VERSION;
  28         my $version_file = "FULL_VERSION";
  29         my $version_handle;
  30         my $versioned_tree = 'packaging/deb';
  31         if (-e $version_file) {
  32                 # Autogen has been run, search FULL_VERSION file.
  33                 if (-e "$version_file") {
  34                         open($version_handle, "<", "$version_file") or
  35                             die "Could not open FULL_VERSION.";
  36                         chomp($VERSION = <$version_handle>);
  37                         close($version_file);
  38
  39                 } else {
  40                         die "Could not find FULL_VERSION file.";
  41                 }
  42         }
  43         if ( ! $VERSION ) {
  44                 # Autogen has not been run or VERSION macro was found.  Try to
  45                 # use svn info.
  46                 my $SVN_URL  = "";
  47                 my $SVN_ROOT = "";
  48                 my $SVN_REV  = "";
  49                 foreach my $info_line (`svn info $versioned_tree`) {
  50                         $SVN_URL  = $1 if $info_line =~ m{^URL: (.*)};
  51                         $SVN_ROOT = $1 if $info_line =~ m{^Repository Root: (.*)};
  52                         $SVN_REV  = $1 if $info_line =~ m{^Revision: (.*)};
  53                 }
  54                 my @paths;
  55                 my $BRANCH;
  56                 my $PROJECT;
  57                 my $svn_version;
  58                 # Only newer versions of svn supply Repository Root.
  59                 if ( $SVN_ROOT ) {
  60                         $SVN_URL =~ m/$SVN_ROOT(.*)/;
  61                         my $SVN_PATH = $1;
  62
  63                         @paths = split "/", $SVN_PATH;
  64                         # We get ( empty, project branch, svn_version...)
  65                         $PROJECT = $paths[1];
  66                         $BRANCH = $paths[2];
  67                         $svn_version = $paths[3];
  68                 } else {
  69                         # This may not work with file or ssh+svn urls.  In an
  70                         # http: url, we get ( Protocol, empty, server, project,
  71                         # branch, svn_version...)
  72                         @paths = split "/", $SVN_URL;
  73                         $PROJECT = $paths[3];
  74                         $BRANCH = $paths[4];
  75                         $svn_version = $paths[5];
  76                 }
  77
  78                 if ( $BRANCH eq "trunk" | $BRANCH eq "branches" ) {
  79                         # Suffix -svn-rev to branch and trunk builds.
  80                 } else {
  81                         # Fix VERSION by stripping up to the first digit
  82                         $svn_version =~ s/^\D*//;
  83                         my $cruft = qr{[_.]};
  84                         if ( $BRANCH eq "branches" ) {
  85                                 # Branch names *should* have only 2 digits.
  86                                 $svn_version =~ m{^(\d)$cruft?(\d)$cruft?(\w*)?};
  87                                 # We throw away anything other than the first
  88                                 # two digits.
  89                                 $VERSION = "$1.$2";
  90                                 # Make sure that the version indicates this is
  91                                 # neither an RC or patch build.
  92                                 $VERSION .= "branch";
  93                         } else {
  94                                 # We should have a tag, which *should* have 3
  95                                 # and maybe an rc## suffix
  96                                 $svn_version =~ m{^(\d)$cruft?(\d)$cruft?(\d)$cruft?(\w*)?};
  97                                 $VERSION = "$1.$2.$3$4";
  98                         }
  99                 }
 100         }
 101         return $VERSION;
 102 }
 103
 104 my $pkg_type;
 105 # Check environment to see if it's something else.
 106 if (defined($ENV{'pkg_type'})) {
 107         $pkg_type = $ENV{"pkg_type"};
 108 }
 109 # Check the file name for a clue
 110 elsif ( $ARGV[0] =~ /deb/ ) {
 111         $pkg_type = "deb";
 112 }
 113 elsif ( $ARGV[0] =~ /rpm/ ) {
 114         $pkg_type = "rpm";
 115 }
 116 elsif ( $ARGV[0] =~ /sun/ ) {
 117         $pkg_type = "sun";
 118 }
 119
 120
 121 # The surrounding line is preserved, and only the tag is replaced.  This
 122 # behavior is somewhat arbitrary, but hopefully keeps replacements in comments
 123 # syntax legal.
 124 my %replacement_strings_common = (
 125         "%%VERSION%%" => get_version(),
 126         "%%AMANDAHOMEDIR%%" => "/var/lib/amanda",
 127         "%%LOGDIR%%" => "/var/log/amanda",
 128 );
 129
 130 my %replacement_strings_deb = (
 131         # Used in debian changelog
 132         "%%DISTRO%%" => "",
 133         # Used in changelog
 134         "%%DEB_REL%%" => "",
 135         "%%DATE%%" => "",
 136         # Used in rules
 137         "%%PERL%%" => "",
 138 );
 139
 140 my %replacement_strings_rpm = (
 141 );
 142
 143 my %replacement_strings_sun = (
 144 );
 145
 146 my %replacement_strings;
 147 if ( $pkg_type eq "deb" ) {
 148         %replacement_strings = ( %replacement_strings_deb,
 149                                  %replacement_strings_common );
 150         # Let's determine the distro:
 151         # Ubuntu has /etc/lsb-release, debian does not
 152         open(my $LSB_RELEASE, "<", "/etc/lsb-release") or
 153                 $replacement_strings{"%%DISTRO%%"} = "Debian";
 154         my $line;
 155         if ( $replacement_strings{"%%DISTRO%%"} ne "Debian" ) {
 156                 $replacement_strings{"%%DISTRO%%"} = "Ubuntu";
 157                 # We want the 2nd line
 158                 <$LSB_RELEASE>;
 159                 my @line = split /=/, <$LSB_RELEASE>;
 160                 chomp($line[1]);
 161                 $line[1] =~ s/\.//;
 162                 $replacement_strings{"%%DEB_REL%%"} = $line[1];
 163                 close($LSB_RELEASE);
 164         } else {
 165                 open(my $DEB_RELEASE, "<", "/etc/debian_version") or die "could not read \"/etc/debian_version\": $!";
 166                 chomp($line = <$DEB_RELEASE>);
 167                 # Releases can have 3 fields.  we want the first 2.
 168                 $line =~ s/(\d+)\.(\d+).*/$1$2/;
 169                 $replacement_strings{"%%DEB_REL%%"} = $line;
 170                 close($DEB_RELEASE);
 171         }
 172         # Set the date using date -r
 173         open(my $DATE_PIPE, "-|", "/bin/date -R") or die "could not read output of date -r";
 174         chomp($line = <$DATE_PIPE>);
 175         $replacement_strings{"%%DATE%%"} = $line;
 176         close($DATE_PIPE);
 177         # 32bit should use bitrock perl, while 64bit should use builtin.  we
 178         # live on the edge and assume it's there.
 179         my @uname=POSIX::uname();
 180         my $arch = $uname[4];
 181         if ( $arch eq "x86_64" ) {
 182                 $replacement_strings{"%%PERL%%"} = $^X;
 183         }
 184         else {
 185                 $replacement_strings{"%%PERL%%"} = "/opt/zmanda/amanda/perl/bin/perl";
 186         }
 187 }
 188 elsif ( $pkg_type eq "rpm" ){
 189         %replacement_strings = ( %replacement_strings_rpm,
 190                                  %replacement_strings_common );
 191 }
 192 else {
 193         %replacement_strings = ( %replacement_strings_sun,
 194                                  %replacement_strings_common );
 195 }
 196
 197 open my $src, "<", $ARGV[0] or die "could not read $ARGV[0]: $!";
 198 open my $dst, ">", $ARGV[1] or die "could not write $ARGV[1]: $!";
 199 select $dst;
 200 while (<$src>) {
 201         chomp;
 202         # check for tags, using non greedy matching
 203         if ( m/(%%.+?%%)/ ) {
 204                 # strings just replace the tag.
 205                 if ( defined($replacement_strings{$1})) {
 206                         s/(%%.+?%%)/$replacement_strings{$1}/g;
 207                         print "$_\n";
 208                 }
 209         }
 210         else {
 211                 # If we got here, print the line unmolested
 212                 print "$_\n";
 213         }
 214 }