Subversion Repositories

?revision_form?Rev ?revision_input??revision_submit??revision_endform?

Rev 1 | Rev 7 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
1 magnus 1
package DebPool::Release;
2
 
3
###
4
#
5
# DebPool::Release - Module for generating and installing Release files
6
#
7
# Copyright 2003-2004 Joel Aelwyn. All rights reserved.
8
# 
9
# Redistribution and use in source and binary forms, with or without
10
# modification, are permitted provided that the following conditions
11
# are met:
12
# 1. Redistributions of source code must retain the above copyright
13
#    notice, this list of conditions and the following disclaimer.
14
# 2. Redistributions in binary form must reproduce the above copyright
15
#    notice, this list of conditions and the following disclaimer in the
16
#    documentation and/or other materials provided with the distribution.
17
# 3. Neither the name of the Author nor the names of any contributors
18
#    may be used to endorse or promote products derived from this software
19
#    without specific prior written permission.
20
# 
21
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
22
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
23
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
24
# ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
25
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
26
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
27
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
28
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
29
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
30
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
31
# SUCH DAMAGE.
32
#
33
# $Id: Release.pm 27 2004-11-07 03:06:59Z joel $
34
#
35
###
36
 
37
# We use 'our', so we must have at least Perl 5.6
38
 
39
require 5.006_000;
40
 
41
# Always good ideas.
42
 
43
use strict;
44
use warnings;
45
 
46
use POSIX; # strftime
47
use File::Temp qw(tempfile);
48
 
49
# We need the Digest modules so that we can calculate the proper checksums.
50
 
51
use Digest::MD5;
52
use Digest::SHA1;
53
 
54
### Module setup
55
 
56
BEGIN {
57
    use Exporter ();
58
    our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
59
 
60
    # Version checking
61
    $VERSION = '0.1.5';
62
 
63
    @ISA = qw(Exporter);
64
 
65
    @EXPORT = qw(
66
    );
67
 
68
    @EXPORT_OK = qw(
69
        &Generate_Release_Triple
70
        &Install_Release
71
    );
72
 
73
    %EXPORT_TAGS = (
74
        'functions' => [qw(&Generate_Release_Triple &Install_Release)],
75
        'vars' => [qw()],
76
    );
77
}
78
 
79
### Exported package globals
80
 
81
### Non-exported package globals
82
 
83
# Thread-safe? What's that? Package global error value. We don't export
84
# this directly, because it would conflict with other modules.
85
 
86
our($Error);
87
 
88
# Magic filenames - these are files we want to include hashes for in a
89
# Release file.
90
 
91
my(@SigFiles) = (
92
    'Packages',
93
    'Sources',
94
    'Packages.gz',
95
    'Sources.gz',
96
);
97
 
98
### File lexicals
99
 
100
# None
101
 
102
### Constant functions
103
 
104
# None
105
 
106
### Meaningful functions
107
 
108
# Generate_Release_Triple($archive, $component, $architecture, $version)
109
#
110
# Generate a Release file for a specific dist/component/arch, in the
111
# temp/working area, and return the filename.
112
#
113
# Returns undef (and sets $Error) on error.
114
 
115
sub Generate_Release_Triple {
116
    use DebPool::Config qw(:vars);
117
    use DebPool::Dirs qw(:functions);
118
 
119
    my($archive, $component, $architecture, $version) = @_;
120
 
121
    my(%Checksums);
122
 
123
    # Before we bother to do much else, generate the MD5 and SHA1 checksums
124
    # we'll need later. This is mostly so that we can catch errors before
125
    # ever bothering to open a tempfile.
126
 
127
    # First, grab a list of files from the directory.
128
 
129
    my($dirpath) = "${Options{'dists_dir'}}/";
130
    $dirpath .= Archfile($archive, $component, $architecture, 1);
131
 
132
    if (!opendir(RELDIR, $dirpath)) {
133
        $Error = "Couldn't open directory '$dirpath'.";
134
        return undef;
135
    }
136
 
137
    my(@dirfiles) = readdir(RELDIR);
138
    close(RELDIR);
139
 
140
    # Now, for each file, generate MD5 and SHA1 checksums, and put them
141
    # into Checksums for later use (assuming it's a file we care about).
142
 
143
    my($ck_file);
144
 
145
    foreach $ck_file (@dirfiles) {
146
        if (0 == grep(/^$ck_file$/, @SigFiles)) { # We don't care about it.
147
            next;
148
        }
149
 
150
        # Grab the filesize from stat()
151
 
152
        my(@stat) = stat("${dirpath}/${ck_file}");
153
        my($size) = $stat[7];
154
 
155
        # Open the file and read in the contents. This could be a very
156
        # large amount of data, but unfortunately, both Digest routines
157
        # require the entire thing at once.
158
 
159
        if (!open(CK_FILE, '<', "${dirpath}/${ck_file}")) {
160
            $Error = "Couldn't open file '${dirpath}/${ck_file}' for reading.";
161
            return undef;
162
        }
163
 
164
        my(@filetext) = <CK_FILE>;
165
        close(CK_FILE);
166
 
167
        # Now calculate the checksums and put them into the hashes.
168
 
169
        my($md5) = Digest::MD5::md5_hex(@filetext);
170
        my($sha1) = Digest::SHA1::sha1_hex(@filetext);
171
 
172
        $Checksums{$ck_file} = {
173
            'Size' => $size,
174
            'MD5' => $md5,
175
            'SHA1' => $sha1,
176
        };
177
    }
178
 
179
    # Open a secure tempfile, and write the headers to it.
180
 
181
    my($tmpfile_handle, $tmpfile_name) = tempfile();
182
 
183
    print $tmpfile_handle "Archive: $archive\n";
184
    print $tmpfile_handle "Component: $component\n";
185
    print $tmpfile_handle "Version: $version\n";
186
    print $tmpfile_handle "Origin: $Options{'release_origin'}\n";
187
    print $tmpfile_handle "Label: $Options{'release_label'}\n";
188
    print $tmpfile_handle "Architecture: $architecture\n";
189
 
190
    # If the archive (aka distribution) appears in release_noauto, print
191
    # the appropriate directive.
192
 
193
    if (0 != grep(/^$archive$/, @{$Options{'release_noauto'}})) {
194
        print $tmpfile_handle "NotAutomatic: yes\n";
195
    }
196
 
197
    print $tmpfile_handle "Description: $Options{'release_description'}\n";
198
 
199
    # Now print MD5 and SHA1 checksum lists.
200
 
201
    print $tmpfile_handle "MD5Sum:\n";
202
    foreach $ck_file (keys(%Checksums)) {
203
        printf $tmpfile_handle " %s %8d %s\n", $Checksums{$ck_file}->{'MD5'},
204
            $Checksums{$ck_file}->{'Size'}, $ck_file;
205
    }
206
 
207
    print $tmpfile_handle "SHA1:\n";
208
    foreach $ck_file (keys(%Checksums)) {
209
        printf $tmpfile_handle " %s %8d %s\n", $Checksums{$ck_file}->{'SHA1'},
210
            $Checksums{$ck_file}->{'Size'}, $ck_file;
211
    }
212
 
213
    close($tmpfile_handle);
214
 
215
    return $tmpfile_name;
216
}
217
 
218
# Generate_Release_Dist($archive, $version, @files)
219
#
220
# Generate top-level Release file for a specific distribution, covering the
221
# given files, in the temp/working area, and return the filename.
222
#
223
# Filenames in @files should be relative to <dists_dir>/<archive>, with no
224
# leading slash (ie, main/binary-i386/Packages).
225
#
226
# Returns undef (and sets $Error) on error.
227
 
228
sub Generate_Release_Dist {
229
    use DebPool::Config qw(:vars);
230
 
231
    my($archive) = shift(@_);
232
    my($version) = shift(@_);
233
    my(@files) = @_;
234
 
235
    my(%Checksums);
236
    my($dists_dir) = $Options{'dists_dir'};
237
 
238
    # Before we bother to do much else, generate the MD5 and SHA1 checksums
239
    # we'll need later. This is mostly so that we can catch errors before
240
    # ever bothering to open a tempfile.
241
 
242
    my($file);
243
    for $file (@files) {
244
        my($fullfile) = "${dists_dir}/${archive}/${file}";
245
 
246
        # Now, for each file, generate MD5 and SHA1 checksums, and put them
247
        # into Checksums for later use (assuming it's a file we care about).
248
 
249
        my(@stat) = stat($fullfile);
250
        my($size) = $stat[7];
251
 
252
        if (!open(HASH_FILE, '<', $fullfile)) {
253
            $Error = "Couldn't open file '${fullfile} for reading.";
254
            return undef;
255
        }
256
        my(@filetext) = <HASH_FILE>;
257
        close(HASH_FILE);
258
 
259
        # Now calculate the checksums and put them into the hashes.
260
 
261
        my($md5) = Digest::MD5::md5_hex(@filetext);
262
        my($sha1) = Digest::SHA1::sha1_hex(@filetext);
263
 
264
        $Checksums{$file} = {
265
            'Size' => $size,
266
            'MD5' => $md5,
267
            'SHA1' => $sha1,
268
        };
269
    }
270
 
271
    # Open a secure tempfile, and set up some variables.
272
 
273
    my($tmpfile_handle, $tmpfile_name) = tempfile();
274
 
275
    my($now_822) = strftime('%a, %d %b %Y %H:%M:%S %Z', localtime());
276
    my(@archs) = grep(!/^source$/, @{$Options{'archs'}});
277
    my($suite) = $Options{'reverse_dists'}->{$archive};
278
 
279
    # Write the headers into the Release tempfile
280
 
281
    print $tmpfile_handle "Origin: ${Options{'release_origin'}}\n";
282
    print $tmpfile_handle "Label: ${Options{'release_label'}}\n";
283
    print $tmpfile_handle "Suite: ${suite}\n";
284
    print $tmpfile_handle "Codename: ${archive}\n";
285
    print $tmpfile_handle "Date: ${now_822}\n";
286
    print $tmpfile_handle "Architectures: " . join(' ', @archs) . "\n";
287
    print $tmpfile_handle "Components: " . join(' ', @{$Options{'sections'}}) . "\n";
288
    print $tmpfile_handle "Description: $Options{'release_description'}\n";
289
 
290
    # Now print MD5 and SHA1 checksum lists.
291
 
292
    print $tmpfile_handle "MD5Sum:\n";
293
    foreach $file (keys(%Checksums)) {
294
        printf $tmpfile_handle " %s %8d %s\n", $Checksums{$file}->{'MD5'},
295
            $Checksums{$file}->{'Size'}, $file;
296
    }
297
 
298
    print $tmpfile_handle "SHA1:\n";
299
    foreach $file (keys(%Checksums)) {
300
        printf $tmpfile_handle " %s %8d %s\n", $Checksums{$file}->{'SHA1'},
301
            $Checksums{$file}->{'Size'}, $file;
302
    }
303
 
304
    close($tmpfile_handle);
305
 
306
    return $tmpfile_name;
307
}
308
 
309
# Install_Release($archive, $component, $architecture, $release, $signature)
310
#
311
# Installs a release file and an optional signature file to the
312
# distribution directory specified by the ($archive, $component,
313
# $architecture) triple, or $archive if $component and $architecture are
314
# undefined. Returns 0 (and sets $Error) on failure, 1 on
315
# success.
316
 
317
sub Install_Release {
318
    use DebPool::Config qw(:vars);
319
    use DebPool::Util qw(:functions);
320
 
321
    my($archive, $component, $architecture, $release, $signature) = @_;
322
 
323
    my($dists_file_mode) = $Options{'dists_file_mode'};
324
 
325
    my($inst_dir);
326
    if (defined($architecture) && defined($component)) {
327
        $inst_dir = "${Options{'dists_dir'}}/";
328
        $inst_dir .= Archfile($archive, $component, $architecture, 1);
329
    } else {
330
        $inst_dir = "${Options{'dists_dir'}}/${archive}";
331
    }
332
 
333
    # Now install the file(s) into the appropriate place(s).
334
 
335
    if (!Move_File($release, "${inst_dir}/Release", $dists_file_mode)) {
336
        $Error = "Couldn't install Release file '${release}' to ";
337
        $Error .= "'${inst_dir}': ${DebPool::Util::Error}";
338
        return 0;
339
    }
340
 
341
    if (defined($signature) && !Move_File($signature, "${inst_dir}/Release.gpg",
342
            $dists_file_mode)) {
343
        $Error = "Couldn't install Signature file '${signature}' to ";
344
        $Error .= "'${inst_dir}': ${DebPool::Util::Error}";
345
        return 0;
346
    }
347
 
348
    return 1;
349
}
350
 
351
END {}
352
 
353
1;
354
 
355
__END__
356
 
357
# vim:set tabstop=4 expandtab: