1#!/usr/bin/perl
2use strict;
3use warnings;
4use 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
14if ( not -e "packaging/common/substitute.pl" ) {
15    die "Error: 'substitute.pl' must be run from the root of a source tree"
16}
17
18sub get_date {
19    my $date;
20    # First parameter should be a date format string.
21    open(my $DATE_PIPE, "-|", "/bin/date $_[0]");
22    [ $? == 0 ] or die "could not read output of date $_[0]";
23    chomp($date = <$DATE_PIPE>);
24    close($DATE_PIPE);
25    return $date;
26};
27
28sub get_arch {
29    my @u = POSIX::uname();
30    return $u[4];
31};
32
33sub read_file {
34	# $1 is the file name and must exist.
35	my $contents;
36	my $file = "$_[0]";
37	my $f_handle;
38	# Autogen has been run, the file will be there.
39	if (-e $file) {
40		open($f_handle, "<", "$file") or
41		    die "Could not open $file.";
42		chomp($contents = <$f_handle>);
43		close($f_handle);
44
45	} else {
46		die "Could not find $file file. run config/set_full_version or ./autogen";
47	}
48	return $contents;
49}
50
51sub fix_pkg_rev {
52    my $pkg_rev = "$_[0]";
53    # $1 should be a package type, and we build the rest of the regex string
54    # here for simplicity
55    my $type_match_str = "$_[1]0?";
56    # strip pkg_type and maybe a zero, else assign pkg_rev = 1
57    $pkg_rev = $pkg_rev =~ s/$type_match_str// || 1;
58    return $pkg_rev;
59    }
60
61my $pkg_type;
62# Check environment to see if it's something else.
63if (defined($ENV{'pkg_type'})) {
64	$pkg_type = $ENV{"pkg_type"};
65}
66# Check the file name for a clue
67elsif ( $ARGV[0] =~ /deb/ ) {
68	$pkg_type = "deb";
69}
70elsif ( $ARGV[0] =~ /rpm/ ) {
71	$pkg_type = "rpm";
72}
73elsif ( $ARGV[0] =~ /sun/ ) {
74	$pkg_type = "sun";
75}
76else {
77    die "Could not determine pkg_type either by environment variable, or
78	pathname of files to substitute ($ARGV[0]).";
79}
80
81# The keys to the hashes used are the "tags" we try to substitute.  Each
82# tag should be on a line by itself in the package file, as the whole line is
83# replaced by a set of lines.  The line may be commented.
84my %replacement_filenames = (
85	"%%COMMON_FUNCTIONS%%" => "packaging/common/common_functions.sh",
86	"%%PRE_INST_FUNCTIONS%%" => "packaging/common/pre_inst_functions.sh",
87	"%%POST_INST_FUNCTIONS%%" => "packaging/common/post_inst_functions.sh",
88	"%%POST_RM_FUNCTIONS%%" => "packaging/common/post_rm_functions.sh",
89# TODO: PRE_UNINST?
90);
91
92# These are handled slightly differently: The surrounding line is preserved,
93# and only the tag is replaced.  This behavior is somewhat arbitrary, but
94# hopefully keeps replacements in comments syntax legal.
95my %replacement_strings_common = (
96	"%%VERSION%%" => read_file("FULL_VERSION"),
97	"%%PKG_REV%%" => read_file("PKG_REV"),
98	"%%AMANDAHOMEDIR%%" => "/var/lib/amanda",
99	"%%LOGDIR%%" => "/var/log/amanda",
100);
101
102my %replacement_strings_deb = (
103	# Used in debian changelog
104	"%%DISTRO%%" => "",
105	# Used in changelog
106	"%%DEB_REL%%" => "",
107	"%%DATE%%" => "'+%a, %d %b %Y %T %z'",
108	# Used in server rules
109	"%%PERL%%" => "",
110);
111
112my %replacement_strings_rpm = (
113	"%%DATE%%" => "'+%a %b %d %Y'",
114);
115
116my %replacement_strings_sun = (
117    "%%ARCH%%" => "",
118    "%%DATE%%" => "'+%a, %d %b %Y %T %z'",
119);
120
121my %replacement_strings;
122if ( $pkg_type eq "deb" ) {
123	%replacement_strings = ( %replacement_strings_deb,
124				 %replacement_strings_common );
125        $replacement_strings{"%%PKG_REV%%"} =
126            fix_pkg_rev($replacement_strings{"%%PKG_REV%%"}, "deb");
127	# Let's determine the distro:
128        my $release;
129        if ( -e "/usr/bin/lsb_release" ) {
130            # Yay!  it's easy.
131            my $distro_id = `/usr/bin/lsb_release --id --short` or die "Could not run lsb_release!";
132            chomp ($replacement_strings{"%%DISTRO%%"} = $distro_id);
133
134            chomp($release = `/usr/bin/lsb_release --release --short`);
135        }
136	if ( $replacement_strings{"%%DISTRO%%"} eq "" ) {
137            # Let's hope it's debian.
138            open(my $DEB_RELEASE, "<", "/etc/debian_version") or die "Could not read \"/etc/debian_version\": $!";
139            # Whew!
140            $replacement_strings{"%%DISTRO%%"} = "Debian";
141            chomp($release = <$DEB_RELEASE>);
142            close($DEB_RELEASE);
143	}
144        # Fix the release version string.
145        if ( $replacement_strings{"%%DISTRO%%"} eq "Ubuntu" ) {
146            $release =~ s/\.//;
147        } else {
148            # Releases can have 3 fields on Debian.  we want the first 2.
149            $release =~ s/(\d+)\.(\d+).*/$1$2/;
150        }
151        $replacement_strings{"%%DEB_REL%%"} = $release;
152	$replacement_strings{"%%DATE%%"} = get_date($replacement_strings{"%%DATE%%"});
153	# 32bit should use bitrock perl, while 64bit should use builtin.  we
154	# live on the edge and assume it's there.
155	my $arch = get_arch();
156	if ( $arch eq "x86_64" ) {
157		$replacement_strings{"%%PERL%%"} = $^X;
158	}
159	else {
160		$replacement_strings{"%%PERL%%"} = "/opt/zmanda/amanda/perl/bin/perl";
161	}
162}
163elsif ( $pkg_type eq "rpm" ){
164	%replacement_strings = ( %replacement_strings_rpm,
165				 %replacement_strings_common );
166        $replacement_strings{"%%PKG_REV%%"} =
167            fix_pkg_rev($replacement_strings{"%%PKG_REV%%"}, "rpm");
168	$replacement_strings{"%%DATE%%"} = get_date($replacement_strings{"%%DATE%%"});
169}
170else {
171	%replacement_strings = ( %replacement_strings_sun,
172				 %replacement_strings_common );
173        $replacement_strings{"%%PKG_REV%%"} =
174            fix_pkg_rev($replacement_strings{"%%PKG_REV%%"}, "sun");
175	$replacement_strings{"%%DATE%%"} = get_date($replacement_strings{"%%DATE%%"});
176	my $arch = get_arch();
177	if ( $arch eq "sun4u" ) {
178	    $replacement_strings{"%%ARCH%%"} = "sparc";
179	}
180	elsif ( $arch eq "i86pc" ) {
181	    $replacement_strings{"%%ARCH%%"} = "intel";
182	}
183	else {
184	    die "Unknown solaris platform!";
185	}
186}
187
188# Make a hash of tags and the contents of replacement files
189my %replacement_data;
190while (my ($tag, $filename) = each %replacement_filenames) {
191	open(my $file, "<", $filename) or die "could not read \"$filename\": $!";
192	$replacement_data{$tag} = join "", <$file>;
193	close($file);
194}
195open my $src, "<", $ARGV[0] or die "could not read $ARGV[0]: $!";
196open my $dst, ">", $ARGV[1] or die "could not write $ARGV[1]: $!";
197select $dst;
198while (<$src>) {
199	chomp;
200	# check for tags, using non greedy matching
201	if ( m/(%%.+?%%)/ ) {
202		# Data replaces the line
203		if ( defined($replacement_data{$1})) {
204			print $replacement_data{$1};
205		}
206		# strings just replace the tag.
207		elsif ( defined($replacement_strings{$1})) {
208			s/(%%.+?%%)/$replacement_strings{$1}/g;
209			print "$_\n";
210		}
211	}
212	else {
213		# If we got here, print the line unmolested
214		print "$_\n";
215	}
216}
217