Imported Upstream version 3.3.1
[debian/amanda] / 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_date {
19     my $date;
20     # Set the date using date -r
21     open(my $DATE_PIPE, "-|", "/bin/date '+%a, %d %b %Y %T %z'");
22     [ $? == 0 ] or die "could not read output of date '+%a, %d %b %Y %T %z'";
23     chomp($date = <$DATE_PIPE>);
24     close($DATE_PIPE);
25     return $date;
26 };
27
28 sub get_arch {
29     my @u = POSIX::uname();
30     return $u[4];
31 };
32
33 sub 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
51 sub 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
61 my $pkg_type;
62 # Check environment to see if it's something else.
63 if (defined($ENV{'pkg_type'})) {
64         $pkg_type = $ENV{"pkg_type"};
65 }
66 # Check the file name for a clue
67 elsif ( $ARGV[0] =~ /deb/ ) {
68         $pkg_type = "deb";
69 }
70 elsif ( $ARGV[0] =~ /rpm/ ) {
71         $pkg_type = "rpm";
72 }
73 elsif ( $ARGV[0] =~ /sun/ ) {
74         $pkg_type = "sun";
75 }
76 else {
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.
84 my %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.
95 my %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
102 my %replacement_strings_deb = (
103         # Used in debian changelog
104         "%%DISTRO%%" => "",
105         # Used in changelog
106         "%%DEB_REL%%" => "",
107         "%%DATE%%" => "",
108         # Used in rules
109         "%%PERL%%" => "",
110 );
111
112 my %replacement_strings_rpm = (
113 );
114
115 my %replacement_strings_sun = (
116     "%%ARCH%%" => "",
117 );
118
119 my %replacement_strings;
120 if ( $pkg_type eq "deb" ) {
121         %replacement_strings = ( %replacement_strings_deb,
122                                  %replacement_strings_common );
123         $replacement_strings{"%%PKG_REV%%"} =
124             fix_pkg_rev($replacement_strings{"%%PKG_REV%%"}, "deb");
125         # Let's determine the distro:
126         # Ubuntu has /etc/lsb-release, debian does not
127         open(my $LSB_RELEASE, "<", "/etc/lsb-release") or 
128                 $replacement_strings{"%%DISTRO%%"} = "Debian";
129         my $line;
130         if ( $replacement_strings{"%%DISTRO%%"} ne "Debian" ) {
131                 $replacement_strings{"%%DISTRO%%"} = "Ubuntu";
132                 # We want the 2nd line
133                 <$LSB_RELEASE>;
134                 my @line = split /=/, <$LSB_RELEASE>;
135                 chomp($line[1]);
136                 $line[1] =~ s/\.//;
137                 $replacement_strings{"%%DEB_REL%%"} = $line[1];
138                 close($LSB_RELEASE);
139         } else {
140                 open(my $DEB_RELEASE, "<", "/etc/debian_version") or die "could not read \"/etc/debian_version\": $!";
141                 chomp($line = <$DEB_RELEASE>);
142                 # Releases can have 3 fields.  we want the first 2.
143                 $line =~ s/(\d+)\.(\d+).*/$1$2/;
144                 $replacement_strings{"%%DEB_REL%%"} = $line;
145                 close($DEB_RELEASE);
146         }
147         $replacement_strings{"%%DATE%%"} = get_date();
148         # 32bit should use bitrock perl, while 64bit should use builtin.  we 
149         # live on the edge and assume it's there.
150         my $arch = get_arch();
151         if ( $arch eq "x86_64" ) {
152                 $replacement_strings{"%%PERL%%"} = $^X;
153         }
154         else {
155                 $replacement_strings{"%%PERL%%"} = "/opt/zmanda/amanda/perl/bin/perl";
156         }
157 }
158 elsif ( $pkg_type eq "rpm" ){
159         %replacement_strings = ( %replacement_strings_rpm,
160                                  %replacement_strings_common );
161         $replacement_strings{"%%PKG_REV%%"} =
162             fix_pkg_rev($replacement_strings{"%%PKG_REV%%"}, "rpm");
163 }
164 else {
165         %replacement_strings = ( %replacement_strings_sun,
166                                  %replacement_strings_common );
167         $replacement_strings{"%%PKG_REV%%"} =
168             fix_pkg_rev($replacement_strings{"%%PKG_REV%%"}, "sun");
169         $replacement_strings{"%%DATE%%"} = get_date();
170         my $arch = get_arch();
171         if ( $arch eq "sun4u" ) {
172             $replacement_strings{"%%ARCH%%"} = "sparc";
173         }
174         elsif ( $arch eq "i86pc" ) {
175             $replacement_strings{"%%ARCH%%"} = "intel";
176         }
177         else {
178             die "Unknown solaris platform!";
179         }
180 }
181
182 # Make a hash of tags and the contents of replacement files
183 my %replacement_data;
184 while (my ($tag, $filename) = each %replacement_filenames) {
185         open(my $file, "<", $filename) or die "could not read \"$filename\": $!";
186         $replacement_data{$tag} = join "", <$file>;
187         close($file);
188 }
189 open my $src, "<", $ARGV[0] or die "could not read $ARGV[0]: $!";
190 open my $dst, ">", $ARGV[1] or die "could not write $ARGV[1]: $!";
191 select $dst;
192 while (<$src>) {
193         chomp;
194         # check for tags, using non greedy matching
195         if ( m/(%%.+?%%)/ ) {
196                 # Data replaces the line
197                 if ( defined($replacement_data{$1})) {
198                         print $replacement_data{$1};
199                 } 
200                 # strings just replace the tag.
201                 elsif ( defined($replacement_strings{$1})) {
202                         s/(%%.+?%%)/$replacement_strings{$1}/g;
203                         print "$_\n";
204                 }
205         }
206         else {
207                 # If we got here, print the line unmolested
208                 print "$_\n";
209         }
210 }