[pve-devel] [RFC common 1/7] add module for APT

[Fabian Ebner <f.ebner@proxmox.com>]

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 <f.ebner@proxmox.com>
---

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