1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
################################################################
#
# Author: Jan Blunck <jblunck@infradead.org>
#
# This file is part of build.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 or 3 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
#################################################################
package Build::LiveBuild;
use strict;
eval { require Archive::Tar; };
*Archive::Tar::new = sub {die("Archive::Tar is not available\n")} unless defined &Archive::Tar::new;
sub filter {
my ($content) = @_;
return '' unless defined $content;
$content =~ s/^#.*$//mg;
$content =~ s/^!.*$//mg;
$content =~ s/^\s*//mg;
return $content;
}
sub parse_package_list {
my ($content) = @_;
my @packages = split /\n/, filter($content);
return @packages;
};
sub parse_archive {
my ($content) = @_;
my @repos;
my @lines = split /\n/, filter($content);
for (@lines) {
next if /^deb-src /;
die("bad path using not obs:/ URL: $_\n") unless $_ =~ /^deb\s+obs:\/\/\/?([^\s\/]+)\/([^\s\/]+)\/?\s+.*$/;
push @repos, "$1/$2";
}
return @repos;
}
sub unify {
my %h = map {$_ => 1} @_;
return grep(delete($h{$_}), @_);
}
sub parse {
my ($config, $filename, @args) = @_;
my $ret = {};
# check that filename is a tar
my $tar = Archive::Tar->new;
unless($tar->read($filename)) {
warn("$filename: " . $tar->error . "\n");
$ret->{'error'} = "$filename: " . $tar->error;
return $ret;
}
# check that directory layout matches live-build directory structure
for my $file ($tar->list_files('')) {
next unless $file =~ /^(.*\/)?config\/archives\/.*\.list.*/;
warn("$filename: config/archives/*.list* files not allowed!\n");
$ret->{'error'} = "$filename: config/archives/*.list* files not allowed!";
return $ret;
}
# always require the list of packages required by live-boot for
# bootstrapping the target distribution image (e.g. with debootstrap)
my @packages = ( 'live-build-desc' );
for my $file ($tar->list_files('')) {
next unless $file =~ /^(.*\/)?config\/package-lists\/.*\.list.*/;
push @packages, parse_package_list($tar->get_content($file));
}
($ret->{'name'} = $filename) =~ s/\.[^.]+$//;
$ret->{'deps'} = [ unify(@packages) ];
return $ret;
}
1;
|
