Allows parsing the configured APT repositories, both the usual .list files in one-line format and the newer .sources files in DEB-822 stanza format.
The plan is to add a few more functions, one for checking the configured repositories and one for the pre-upgrade step of replacing the old suite name with the newer one. Also, other functions that currently live in pve-managers's and pmg-api's API2/APT.pm might make sense to unify and move here. Signed-off-by: Fabian Ebner <[email protected]> --- Note that a commented out stanza is not detected even if the commented out things are a valid repository configuration. Since we plan to also write repository files in the future such repositories could get lost then. That said, stanzas can also get disabled by adding an Enabled: false option. I'm not sure if it's worth trying to detect the commented out ones. src/Makefile | 1 + src/PVE/APT.pm | 290 +++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 291 insertions(+) create mode 100644 src/PVE/APT.pm diff --git a/src/Makefile b/src/Makefile index 098a648..7e5e3cd 100644 --- a/src/Makefile +++ b/src/Makefile @@ -8,6 +8,7 @@ PERLDIR=${PREFIX}/share/perl5 LIB_SOURCES = \ AtomicFile.pm \ + APT.pm \ Certificate.pm \ CLIFormatter.pm \ CLIHandler.pm \ diff --git a/src/PVE/APT.pm b/src/PVE/APT.pm new file mode 100644 index 0000000..75d1810 --- /dev/null +++ b/src/PVE/APT.pm @@ -0,0 +1,290 @@ +package PVE::APT; + +use strict; +use warnings; + +use PVE::Tools; + +my $sources_list_path = '/etc/apt/sources.list'; +my $sources_dir_path = '/etc/apt/sources.list.d'; + +# see APT's StringToBool() in apt-pkg/contrib/strutl.cc +my $string_to_bool = sub { + my ($string) = @_; + + return if !defined($string); + + $string = lc($string); + + return 0 if $string =~ m/^(0|no|false|without|off|disable)$/; + return 1 if $string =~ m/^(1|yes|true|with|on|enable)$/; + return; +}; + +my $split_list = sub { + my ($line) = @_; + + return [] if !defined($line); + + $line =~ s/^\s+//; + return [ split(/\s+/, $line) ]; +}; + +my $consume_key = sub { + my ($line) = @_; + + if ($line =~ m/^(\S+?):/) { + my ($key, $index) = ($1, $+[0]); + $line = substr($line, $index); + return ($key, $line); + } + return (undef, $line); +}; + +my $consume_token = sub { + my ($line) = @_; + + if ($line =~ m/^\s*(\S+)/) { + my ($token, $index) = ($1, $+[0]); + $line = substr($line, $index); + return ($token, $line); + } + return (undef, $line); +}; + +my $consume_comment = sub { + my ($line) = @_; + + my $start = index($line, '#'); + if ($start != -1) { + my $comment = substr($line, $start + 1); + $line = substr($line, 0, $start) if $start != -1; + return ($comment, $line); + } + return (undef, $line); +}; + +my $consume_options = sub { + my ($line) = @_; + + my $options = {}; + + if ($line =~ m/^\s*(\[)/) { + $line = substr($line, $+[0]); + + my $finished; + while ($line !~ m/^\s*\]/ && !$finished) { + (my $option, $line) = $consume_token->($line); + + $finished = 1 if $option =~ s/]$//; + + if ($option =~ m/(^[^=]+)=(.+)$/) { + $options->{$1} = $2; + } else { + die "malformed option '$option'\n"; + } + } + $line =~ s/^\s*\]//; + } + return ($options, $line); +}; + +my $basic_repodata_check = sub { + my ($repo) = @_; + + die "missing type(s)\n" if !defined($repo->{Types}); + + my $uris = $split_list->($repo->{URIs}); + die "missing URI(s)\n" if !scalar(@{$uris}); + foreach my $uri (@{$uris}) { + die "invalid URI: '$uri'\n" if $uri !~ m/\S+:\S+/; + } + + my $suites = $split_list->($repo->{Suites}); + my $components = $split_list->($repo->{Components}); + die "missing suite(s)\n" if !scalar(@{$suites}); + foreach my $suite (@{$suites}) { + if ($suite !~ m|/$| && !scalar(@{$components})) { + die "missing component(s)\n" + } elsif ($suite =~ m|/$| && scalar(@{$components})) { + die "absolute suite '$suite' does not allow components\n"; + } + } +}; + +my $parse_one_line = sub { + my ($line) = @_; + + my $repo = {}; + + (my $comment, $line) = $consume_comment->($line); + $repo->{comment} = $comment if defined($comment); + ($repo->{Types}, $line) = $consume_token->($line); + ($repo->{Options}, $line) = $consume_options->($line); + ($repo->{URIs}, $line) = $consume_token->($line); + ($repo->{Suites}, $line) = $consume_token->($line); + $line =~ s/^\s+//; + $repo->{Components} = $line if length($line); + + $basic_repodata_check->($repo); + + return $repo; +}; + +# .list file with one-line style +sub parse_list_file { + my ($path) = @_; + + my $content = PVE::Tools::file_get_contents($path); + my @lines = split(/\n/, $content); + + my $repos = []; + my $outer_comment = ''; + + my $add_repo = sub { + my ($line_number, $enabled, $repo_data) = @_; + + my $full_comment = ''; + $full_comment = $outer_comment . "\n" if length($outer_comment); + $full_comment .= $repo_data->{comment} // ''; + $repo_data->{comment} = $full_comment if length($full_comment); + $outer_comment = ''; + + push @{$repos}, { + path => $path, + number => $line_number, + enabled => $enabled, + %{$repo_data}, + }; + }; + + my $line_number = 0; + foreach my $line (@lines) { + $line_number++; + + if ($line =~/^\s*$/) { + $outer_comment = ''; + next; + } + + # determine if it's a commented out/disabled repo or just a comment + if ($line =~ /^\s*#/) { + my $commented_out = substr($line, $+[0]); + my $repo_data = eval { $parse_one_line->($commented_out); }; + if (my $err = $@) { + $outer_comment .= "\n" if length($outer_comment); + $outer_comment .= $commented_out; + } else { + $add_repo->($line_number, 0, $repo_data); + } + next; + } + + my $repo_data = eval { $parse_one_line->($line); }; + if (my $err = $@) { + die "malformed entry in '$path' line $line_number - $err"; + } else { + $add_repo->($line_number, 1, $repo_data); + } + } + + return $repos; +} + +my $parse_stanza_line = sub { + my ($line, $repo) = @_; + + (my $key, $line) = $consume_key->($line); + die "missing value(s) for option '$key'\n" if $line !~ m/\S+/; + $line =~ s/^\s+//; + + if ($key =~ m/^(Types|URIs|Suites|Components)$/) { + $repo->{$key} = $line; + } else { + $repo->{Options}->{$key} = $line; + } +}; + +my $parse_stanza = sub { + my ($stanza) = @_; + + my @lines = split(/\n/, $stanza); + + my $repo = { Options => {} }; + my $empty = 1; # might be only comments + my $comment = ''; + + my $line_number = 0; + foreach my $line (@lines) { + $line_number++; + + if ($line =~ m/^#/) { + my $commented_out = substr($line, $+[0]); + $comment .= "\n" if length($comment); + $comment .= $commented_out; + next; + } + + $empty = 0; + + eval { $parse_stanza_line->($line, $repo); }; + die "line ${line_number} - $@" if $@; + } + + return if $empty; + + $repo->{comment} = $comment; + + $basic_repodata_check->($repo); + + return $repo; +}; + +# .sources file in DEB822 format +sub parse_sources_file { + my ($path) = @_; + + my $content = PVE::Tools::file_get_contents($path); + my @stanzas = split(/\n\s*\n/, $content); + + my $repos = []; + + my $stanza_number = 0; + foreach my $stanza (@stanzas) { + $stanza_number++; + + my $repo_data = eval { $parse_stanza->($stanza); }; + if (my $err = $@) { + die "malformed entry in '$path' stanza $stanza_number - $err"; + } elsif (defined($repo_data)) { + my $enabled = $repo_data->{Options}->{Enabled}; + $enabled = $string_to_bool->($enabled) // 1; + push @{$repos}, { + path => $path, + number => $stanza_number, + enabled => $enabled, + %{$repo_data}, + }; + } + } + + return $repos; +} + +sub list_repositories { + my $repos = parse_list_file($sources_list_path); + PVE::Tools::dir_glob_foreach($sources_dir_path, '[^.]+\.list', sub { + my ($filename) = @_; + my $file_repositories = parse_list_file("${sources_dir_path}/${filename}"); + push @{$repos}, @{$file_repositories}; + }); + PVE::Tools::dir_glob_foreach($sources_dir_path, '[^.]+\.sources', sub { + my ($filename) = @_; + my $file_repositories = parse_sources_file("${sources_dir_path}/${filename}"); + push @{$repos}, @{$file_repositories}; + }); + + return $repos; +} + +1; -- 2.20.1 _______________________________________________ pve-devel mailing list [email protected] https://lists.proxmox.com/cgi-bin/mailman/listinfo/pve-devel
