From: Luke Harding <luke@lukeh990.io>
To: pve-devel@lists.proxmox.com
Cc: Luke Harding <luke@lukeh990.io>
Subject: [pve-devel] [PATCH dab 6/7] Run proxmox-perltidy
Date: Tue, 18 Nov 2025 17:01:21 -0500 [thread overview]
Message-ID: <20251118220122.61257-7-luke@lukeh990.io> (raw)
In-Reply-To: <20251118220122.61257-1-luke@lukeh990.io>
This made lots of changes feel free to drop it.
Signed-off-by: Luke Harding <luke@lukeh990.io>
---
PVE/DAB.pm | 1494 +++++++++++++++++++++++++++-------------------------
dab | 235 +++++----
2 files changed, 885 insertions(+), 844 deletions(-)
diff --git a/PVE/DAB.pm b/PVE/DAB.pm
index f42b937..b074460 100644
--- a/PVE/DAB.pm
+++ b/PVE/DAB.pm
@@ -63,72 +63,72 @@ sub __url_to_filename {
# systemd: true
my $suite_defaults = {
debian => {
- keyring => '/usr/share/keyrings/debian-archive-keyring.gpg',
+ keyring => '/usr/share/keyrings/debian-archive-keyring.gpg',
},
devuan => {
- #keyring => '/usr/share/keyrings/devuan-archive-keyring.gpg', # TODO: verify
- systemd => 0,
+ #keyring => '/usr/share/keyrings/devuan-archive-keyring.gpg', # TODO: verify
+ systemd => 0,
},
ubuntu => {
- keyring => '/usr/share/keyrings/ubuntu-archive-keyring.gpg',
+ keyring => '/usr/share/keyrings/ubuntu-archive-keyring.gpg',
},
};
my $supported_suites = {
'trixie' => {
- ostype => "debian-13",
- modern_apt_sources => 1,
+ ostype => "debian-13",
+ modern_apt_sources => 1,
},
'bookworm' => {
- ostype => "debian-12",
+ ostype => "debian-12",
},
'bullseye' => {
- ostype => "debian-11",
+ ostype => "debian-11",
},
-# DEVUAN (imply systemd = 0 default)
+ # DEVUAN (imply systemd = 0 default)
'beowulf' => {
- ostype => "devuan-3.0",
- origin => 'devuan',
+ ostype => "devuan-3.0",
+ origin => 'devuan',
},
'chimaera' => {
- ostype => "devuan-4.0",
- origin => 'devuan',
+ ostype => "devuan-4.0",
+ origin => 'devuan',
},
'daedalus' => {
- ostype => "devuan-5.0",
- origin => 'devuan',
+ ostype => "devuan-5.0",
+ origin => 'devuan',
},
'excalibur' => {
- ostype => "devuan-6.0",
- origin => 'devuan',
+ ostype => "devuan-6.0",
+ origin => 'devuan',
},
-# UBUNTU
+ # UBUNTU
'bionic' => {
- ostype => "ubuntu-18.04",
- origin => 'ubuntu',
+ ostype => "ubuntu-18.04",
+ origin => 'ubuntu',
},
'focal' => {
- ostype => "ubuntu-20.04",
- origin => 'ubuntu',
+ ostype => "ubuntu-20.04",
+ origin => 'ubuntu',
},
'jammy' => {
- ostype => "ubuntu-22.04",
- origin => 'ubuntu',
+ ostype => "ubuntu-22.04",
+ origin => 'ubuntu',
},
'noble' => {
- ostype => "ubuntu-24.04",
- origin => 'ubuntu',
+ ostype => "ubuntu-24.04",
+ origin => 'ubuntu',
},
'oracular' => {
- ostype => "ubuntu-24.10",
- origin => 'ubuntu',
+ ostype => "ubuntu-24.10",
+ origin => 'ubuntu',
},
'plucky' => {
- ostype => "ubuntu-25.04",
- origin => 'ubuntu',
- modern_apt_sources => 1,
+ ostype => "ubuntu-25.04",
+ origin => 'ubuntu',
+ modern_apt_sources => 1,
},
};
@@ -139,8 +139,8 @@ sub get_suite_info {
# set defaults
$suiteinfo->{origin} //= 'debian';
- if (my $defaults = $suite_defaults->{$suiteinfo->{origin}}) {
- $suiteinfo->{$_} //= $defaults->{$_} for keys $defaults->%*;
+ if (my $defaults = $suite_defaults->{ $suiteinfo->{origin} }) {
+ $suiteinfo->{$_} //= $defaults->{$_} for keys $defaults->%*;
}
$suiteinfo->{suite} //= $suite;
$suiteinfo->{systemd} //= 1;
@@ -152,15 +152,15 @@ sub download {
my ($self, $url, $path) = @_;
my $tmpfn = "$path.tmp$$";
- $self->logmsg ("download: $url\n");
+ $self->logmsg("download: $url\n");
- eval { $self->run_command ("wget -q '$url' -O '$tmpfn'") };
+ eval { $self->run_command("wget -q '$url' -O '$tmpfn'") };
if (my $err = $@) {
- unlink $tmpfn;
- die $err;
+ unlink $tmpfn;
+ die $err;
}
- rename ($tmpfn, $path);
+ rename($tmpfn, $path);
}
sub write_file {
@@ -170,8 +170,8 @@ sub write_file {
unlink $file;
- my $fh = IO::File->new ($file, O_WRONLY | O_CREAT, $perm) ||
- die "unable to open file '$file'";
+ my $fh = IO::File->new($file, O_WRONLY | O_CREAT, $perm)
+ || die "unable to open file '$file'";
print $fh $data;
@@ -183,11 +183,11 @@ sub read_file {
die "no filename" if !$file;
- my $fh = IO::File->new ($file) ||
- die "unable to open file '$file'";
+ my $fh = IO::File->new($file)
+ || die "unable to open file '$file'";
local $/; # slurp mode
-
+
my $data = <$fh>;
$fh->close;
@@ -205,39 +205,39 @@ sub read_config {
my $res = {};
- my $fh = IO::File->new ("<$filename") || return $res;
+ my $fh = IO::File->new("<$filename") || return $res;
my $rec = '';
- while (defined (my $line = <$fh>)) {
- next if $line =~ m/^\#/;
- next if $line =~ m/^\s*$/;
- $rec .= $line;
- };
+ while (defined(my $line = <$fh>)) {
+ next if $line =~ m/^\#/;
+ next if $line =~ m/^\s*$/;
+ $rec .= $line;
+ }
- close ($fh);
+ close($fh);
chomp $rec;
$rec .= "\n";
while ($rec) {
- if ($rec =~ s/^Description:\s*([^\n]*)(\n\s+.*)*$//si) {
- $res->{headline} = $1;
- chomp $res->{headline};
- my $long = $2;
- $long =~ s/^\s+/ /;
- $res->{description} = $long;
- chomp $res->{description};
- } elsif ($rec =~ s/^([^:]+):\s*(.*\S)\s*\n//) {
- my ($key, $value) = (lc ($1), $2);
- if ($key eq 'source' || $key eq 'mirror' || $key eq 'install-source') {
- push @{$res->{$key}}, $value;
- } else {
- die "duplicate key '$key'\n" if defined ($res->{$key});
- $res->{$key} = $value;
- }
- } else {
- die "unable to parse config file: $rec";
- }
+ if ($rec =~ s/^Description:\s*([^\n]*)(\n\s+.*)*$//si) {
+ $res->{headline} = $1;
+ chomp $res->{headline};
+ my $long = $2;
+ $long =~ s/^\s+/ /;
+ $res->{description} = $long;
+ chomp $res->{description};
+ } elsif ($rec =~ s/^([^:]+):\s*(.*\S)\s*\n//) {
+ my ($key, $value) = (lc($1), $2);
+ if ($key eq 'source' || $key eq 'mirror' || $key eq 'install-source') {
+ push @{ $res->{$key} }, $value;
+ } else {
+ die "duplicate key '$key'\n" if defined($res->{$key});
+ $res->{$key} = $value;
+ }
+ } else {
+ die "unable to parse config file: $rec";
+ }
}
die "unable to parse config file" if $rec;
@@ -250,28 +250,28 @@ sub run_command {
my $reader = IO::File->new();
my $writer = IO::File->new();
- my $error = IO::File->new();
+ my $error = IO::File->new();
my $orig_pid = $$;
- my $cmdstr = ref ($cmd) eq 'ARRAY' ? join (' ', @$cmd) : $cmd;
+ my $cmdstr = ref($cmd) eq 'ARRAY' ? join(' ', @$cmd) : $cmd;
my $pid;
eval {
- if (ref ($cmd) eq 'ARRAY') {
- $pid = open3 ($writer, $reader, $error, @$cmd) || die $!;
- } else {
- $pid = open3 ($writer, $reader, $error, $cmdstr) || die $!;
- }
+ if (ref($cmd) eq 'ARRAY') {
+ $pid = open3($writer, $reader, $error, @$cmd) || die $!;
+ } else {
+ $pid = open3($writer, $reader, $error, $cmdstr) || die $!;
+ }
};
my $err = $@;
# catch exec errors
if ($orig_pid != $$) {
- $self->logmsg ("ERROR: command '$cmdstr' failed - fork failed\n");
- POSIX::_exit (1);
- kill ('KILL', $$);
+ $self->logmsg("ERROR: command '$cmdstr' failed - fork failed\n");
+ POSIX::_exit(1);
+ kill('KILL', $$);
}
die $err if $err;
@@ -280,31 +280,31 @@ sub run_command {
close $writer;
my $select = IO::Select->new();
- $select->add ($reader);
- $select->add ($error);
+ $select->add($reader);
+ $select->add($error);
my $res = '';
my $logfd = $self->{logfd};
while ($select->count) {
- my @handles = $select->can_read ();
+ my @handles = $select->can_read();
- foreach my $h (@handles) {
- my $buf = '';
- my $count = sysread ($h, $buf, 4096);
- if (!defined ($count)) {
- waitpid ($pid, 0);
- die "command '$cmdstr' failed: $!";
- }
- $select->remove ($h) if !$count;
+ foreach my $h (@handles) {
+ my $buf = '';
+ my $count = sysread($h, $buf, 4096);
+ if (!defined($count)) {
+ waitpid($pid, 0);
+ die "command '$cmdstr' failed: $!";
+ }
+ $select->remove($h) if !$count;
- print $logfd $buf;
+ print $logfd $buf;
- $res .= $buf if $getoutput;
- }
+ $res .= $buf if $getoutput;
+ }
}
- waitpid ($pid, 0);
+ waitpid($pid, 0);
my $ec = ($? >> 8);
die "command '$cmdstr' failed with exit code $ec\n" if $ec;
@@ -315,7 +315,7 @@ sub run_command {
sub logmsg {
my $self = shift;
print STDERR @_;
- $self->writelog (@_);
+ $self->writelog(@_);
}
sub writelog {
@@ -333,17 +333,17 @@ sub __sample_config {
my $ostype = $self->{config}->{ostype};
if ($ostype =~ m/^de(bi|vu)an-/) {
- $data .= "lxc.include = /usr/share/lxc/config/debian.common.conf\n";
- $data .= "lxc.include = /usr/share/lxc/config/debian.userns.conf\n" if $> != 0;
+ $data .= "lxc.include = /usr/share/lxc/config/debian.common.conf\n";
+ $data .= "lxc.include = /usr/share/lxc/config/debian.userns.conf\n" if $> != 0;
} elsif ($ostype =~ m/^ubuntu-/) {
- $data .= "lxc.include = /usr/share/lxc/config/ubuntu.common.conf\n";
- $data .= "lxc.include = /usr/share/lxc/config/ubuntu.userns.conf\n" if $> != 0;
+ $data .= "lxc.include = /usr/share/lxc/config/ubuntu.common.conf\n";
+ $data .= "lxc.include = /usr/share/lxc/config/ubuntu.userns.conf\n" if $> != 0;
} else {
- die "unknown os type '$ostype'\n";
+ die "unknown os type '$ostype'\n";
}
if ($> != 0) {
- $data .= "lxc.idmap = u 0 100000 65536\n";
- $data .= "lxc.idmap = g 0 100000 65536\n";
+ $data .= "lxc.idmap = u 0 100000 65536\n";
+ $data .= "lxc.idmap = g 0 100000 65536\n";
}
$data .= "lxc.uts.name = localhost\n";
$data .= "lxc.rootfs.path = $self->{rootfs}\n";
@@ -355,20 +355,19 @@ sub __allocate_ve {
my ($self) = @_;
my $cid;
- if (my $fd = IO::File->new (".veid")) {
- $cid = <$fd>;
- chomp $cid;
- close ($fd);
+ if (my $fd = IO::File->new(".veid")) {
+ $cid = <$fd>;
+ chomp $cid;
+ close($fd);
}
-
$self->{working_dir} = getcwd;
$self->{veconffile} = "$self->{working_dir}/config";
$self->{rootfs} = "$self->{working_dir}/rootfs";
if ($cid) {
- $self->{veid} = $cid;
- return $cid;
+ $self->{veid} = $cid;
+ return $cid;
}
my $uuid;
@@ -377,21 +376,21 @@ sub __allocate_ve {
UUID::unparse($uuid, $uuid_str);
$self->{veid} = $uuid_str;
- my $fd = IO::File->new (">.veid") ||
- die "unable to write '.veid'\n";
+ my $fd = IO::File->new(">.veid")
+ || die "unable to write '.veid'\n";
print $fd "$self->{veid}\n";
- close ($fd);
+ close($fd);
my $cdata = $self->__sample_config();
- my $fh = IO::File->new ($self->{veconffile}, O_WRONLY|O_CREAT|O_EXCL) ||
- die "unable to write lxc config file '$self->{veconffile}' - $!";
+ my $fh = IO::File->new($self->{veconffile}, O_WRONLY | O_CREAT | O_EXCL)
+ || die "unable to write lxc config file '$self->{veconffile}' - $!";
print $fh $cdata;
- close ($fh);
+ close($fh);
mkdir $self->{rootfs} || die "unable to create rootfs - $!";
- $self->logmsg ("allocated VE $self->{veid}\n");
+ $self->logmsg("allocated VE $self->{veid}\n");
return $self->{veid};
}
@@ -405,9 +404,9 @@ sub can_usr_merge {
# FIXME: add configuration override posibillity
if ($ostype =~ m/^debian-(\d+)/) {
- return int($1) >= 11;
+ return int($1) >= 11;
} elsif ($ostype =~ m/^ubuntu-(\d+)/) {
- return int($1) >= 21;
+ return int($1) >= 21;
}
return; # false
}
@@ -422,16 +421,16 @@ sub setup_usr_merge {
my @merged_dirs = qw(bin sbin lib);
if ($arch eq 'amd64') {
- push @merged_dirs, qw(lib32 lib64 libx32);
+ push @merged_dirs, qw(lib32 lib64 libx32);
} elsif ($arch eq 'i386') {
- push @merged_dirs, qw(lib64 libx32);
+ push @merged_dirs, qw(lib64 libx32);
}
- $self->logmsg ("setup usr-merge symlinks for '" . join("', '", @merged_dirs) . "'\n");
+ $self->logmsg("setup usr-merge symlinks for '" . join("', '", @merged_dirs) . "'\n");
for my $dir (@merged_dirs) {
- symlink("usr/$dir", "$rootfs/$dir") or warn "could not create symlink - $!\n";
- mkpath "$rootfs/usr/$dir";
+ symlink("usr/$dir", "$rootfs/$dir") or warn "could not create symlink - $!\n";
+ mkpath "$rootfs/usr/$dir";
}
}
@@ -441,25 +440,25 @@ sub get_target_name {
my $name = $config->{name} || die "no 'name' specified\n";
$name =~ m/^[a-z][0-9a-z\-\*\.]+$/ || die "illegal characters in name '$name'\n";
- my ($version, $arch, $ostype) = $config->@{'version', 'architecture', 'ostype'};
+ my ($version, $arch, $ostype) = $config->@{ 'version', 'architecture', 'ostype' };
$name = "${ostype}-${name}" if $name !~ m/^$ostype/;
- return "${name}_${version}_${arch}"
+ return "${name}_${version}_${arch}";
}
sub new {
my ($class, $config) = @_;
- $class = ref ($class) || $class;
- $config = read_config ('dab.conf') if !$config;
+ $class = ref($class) || $class;
+ $config = read_config('dab.conf') if !$config;
my $self = {
- config => $config,
+ config => $config,
};
bless $self, $class;
$self->{logfile} = "logfile";
- $self->{logfd} = IO::File->new (">>$self->{logfile}") || die "unable to open log file";
+ $self->{logfd} = IO::File->new(">>$self->{logfile}") || die "unable to open log file";
my $arch = $config->{architecture} || die "no 'architecture' specified\n";
die "unsupported architecture '$arch'\n" if $arch !~ m/^(i386|amd64)$/;
@@ -472,113 +471,118 @@ sub new {
# assert required dab.conf keys exist
for my $key (qw(version section headline maintainer)) {
- die "no '$key' specified\n" if !$config->{$key};
+ die "no '$key' specified\n" if !$config->{$key};
}
$self->{targetname} = get_target_name($config);
if (!$config->{source}) {
- if (lc($suiteinfo->{origin}) eq 'debian') {
- push @{$config->{source}}, (
- "http://deb.debian.org/debian SUITE main contrib",
- "http://deb.debian.org/debian SUITE-updates main contrib",
- "http://security.debian.org SUITE-security main contrib",
- );
- } elsif (lc($suiteinfo->{origin}) eq 'ubuntu') {
- my $comp = "main restricted universe multiverse";
- push @{$config->{source}}, (
- "http://archive.ubuntu.com/ubuntu SUITE $comp",
- "http://archive.ubuntu.com/ubuntu SUITE-updates $comp",
- "http://archive.ubuntu.com/ubuntu SUITE-security $comp",
- );
- } else {
- die "implement me";
- }
+ if (lc($suiteinfo->{origin}) eq 'debian') {
+ push @{ $config->{source} },
+ (
+ "http://deb.debian.org/debian SUITE main contrib",
+ "http://deb.debian.org/debian SUITE-updates main contrib",
+ "http://security.debian.org SUITE-security main contrib",
+ );
+ } elsif (lc($suiteinfo->{origin}) eq 'ubuntu') {
+ my $comp = "main restricted universe multiverse";
+ push @{ $config->{source} },
+ (
+ "http://archive.ubuntu.com/ubuntu SUITE $comp",
+ "http://archive.ubuntu.com/ubuntu SUITE-updates $comp",
+ "http://archive.ubuntu.com/ubuntu SUITE-security $comp",
+ );
+ } else {
+ die "implement me";
+ }
}
my $sources = undef;
- foreach my $s (@{$config->{source}}) {
- if ($s =~ m@^\s*((https?|ftp)://\S+)\s+(\S+)((\s+(\S+))+)$@) {
- my ($url, $su, $components) = ($1, $3, $4);
- $su =~ s/SUITE/$suite/;
- $components =~ s/^\s+//;
- $components =~ s/\s+$//;
- my $ca;
- foreach my $co (split (/\s+/, $components)) {
- push @$ca, $co;
- }
- $ca = ['main'] if !$ca;
-
- push @$sources, {
- source => $url,
- comp => $ca,
- suite => $su,
- keep => 1,
- };
- } else {
- die "syntax error in source specification '$s'\n";
- }
- }
-
- foreach my $is (@{$config->{'install-source'}}) {
- if ($is =~ m@^\s*((https?|ftp)://\S+)\s+(\S+)((\s+(\S+))+)$@) {
- my ($url, $su, $components) = ($1, $3, $4);
- $su =~ s/SUITE/$suite/;
- $components =~ s/^\s+//;
- $components =~ s/\s+$//;
- my $ca;
- foreach my $co (split (/\s+/, $components)) {
- push @$ca, $co;
- }
- $ca = ['main'] if !$ca;
-
- push @$sources, {
- source => $url,
- comp => $ca,
- suite => $su,
- keep => 0,
- };
- } else {
- die "syntax error in install-source specification '$is'\n";
- }
- }
-
- foreach my $m (@{$config->{mirror}}) {
- if ($m =~ m@^\s*((https?|ftp)://\S+)\s*=>\s*((https?|ftp)://\S+)\s*$@) {
- my ($ms, $md) = ($1, $3);
- my $found;
- foreach my $ss (@$sources) {
- if ($ss->{source} eq $ms) {
- $found = 1;
- $ss->{mirror} = $md;
- last;
- }
- }
- die "unusable mirror $ms\n" if !$found;
- } else {
- die "syntax error in mirror spezification '$m'\n";
- }
+ foreach my $s (@{ $config->{source} }) {
+ if ($s =~ m@^\s*((https?|ftp)://\S+)\s+(\S+)((\s+(\S+))+)$@) {
+ my ($url, $su, $components) = ($1, $3, $4);
+ $su =~ s/SUITE/$suite/;
+ $components =~ s/^\s+//;
+ $components =~ s/\s+$//;
+ my $ca;
+ foreach my $co (split(/\s+/, $components)) {
+ push @$ca, $co;
+ }
+ $ca = ['main'] if !$ca;
+
+ push @$sources,
+ {
+ source => $url,
+ comp => $ca,
+ suite => $su,
+ keep => 1,
+ };
+ } else {
+ die "syntax error in source specification '$s'\n";
+ }
+ }
+
+ foreach my $is (@{ $config->{'install-source'} }) {
+ if ($is =~ m@^\s*((https?|ftp)://\S+)\s+(\S+)((\s+(\S+))+)$@) {
+ my ($url, $su, $components) = ($1, $3, $4);
+ $su =~ s/SUITE/$suite/;
+ $components =~ s/^\s+//;
+ $components =~ s/\s+$//;
+ my $ca;
+ foreach my $co (split(/\s+/, $components)) {
+ push @$ca, $co;
+ }
+ $ca = ['main'] if !$ca;
+
+ push @$sources,
+ {
+ source => $url,
+ comp => $ca,
+ suite => $su,
+ keep => 0,
+ };
+ } else {
+ die "syntax error in install-source specification '$is'\n";
+ }
+ }
+
+ foreach my $m (@{ $config->{mirror} }) {
+ if ($m =~ m@^\s*((https?|ftp)://\S+)\s*=>\s*((https?|ftp)://\S+)\s*$@) {
+ my ($ms, $md) = ($1, $3);
+ my $found;
+ foreach my $ss (@$sources) {
+ if ($ss->{source} eq $ms) {
+ $found = 1;
+ $ss->{mirror} = $md;
+ last;
+ }
+ }
+ die "unusable mirror $ms\n" if !$found;
+ } else {
+ die "syntax error in mirror spezification '$m'\n";
+ }
}
$self->{sources} = $sources;
$self->{infodir} = "info";
$self->__allocate_ve();
- $self->{cachedir} = ($config->{cachedir} || 'cache') . "/$suite";;
+ $self->{cachedir} = ($config->{cachedir} || 'cache') . "/$suite";
my $incl = [qw (less ssh openssh-server logrotate)];
my $excl = [qw (modutils reiserfsprogs ppp pppconfig pppoe pppoeconf nfs-common mtools ntp)];
# ubuntu has too many dependencies on udev, so we cannot exclude it (instead we disable udevd)
if (lc($suiteinfo->{origin}) eq 'ubuntu' && $suiteinfo->{systemd}) {
- push @$incl, 'isc-dhcp-client';
- push @$excl, qw(libmodule-build-perl libdrm-common libdrm2 libplymouth5 plymouth plymouth-theme-ubuntu-text powermgmt-base);
- if ($suite eq 'jammy') {
- push @$excl, qw(fuse); # avoid fuse2 <-> fuse3 conflict
- }
+ push @$incl, 'isc-dhcp-client';
+ push @$excl,
+ qw(libmodule-build-perl libdrm-common libdrm2 libplymouth5 plymouth plymouth-theme-ubuntu-text powermgmt-base);
+ if ($suite eq 'jammy') {
+ push @$excl, qw(fuse); # avoid fuse2 <-> fuse3 conflict
+ }
} else {
- push @$excl, qw(module-init-tools pciutils hdparm memtest86+ parted);
+ push @$excl, qw(module-init-tools pciutils hdparm memtest86+ parted);
}
$self->{incl} = $incl;
@@ -597,51 +601,51 @@ sub initialize {
mkpath $infodir;
# truncate log
- my $logfd = $self->{logfd} = IO::File->new (">$self->{logfile}") ||
- die "unable to open log file";
+ my $logfd = $self->{logfd} = IO::File->new(">$self->{logfile}")
+ || die "unable to open log file";
my $COMPRESSORS = [
- {
- ext => 'xz',
- decomp => 'xz -d',
- },
- {
- ext => 'gz',
- decomp => 'gzip -d',
- },
+ {
+ ext => 'xz',
+ decomp => 'xz -d',
+ },
+ {
+ ext => 'gz',
+ decomp => 'gzip -d',
+ },
];
- foreach my $ss (@{$self->{sources}}) {
- my $src = $ss->{mirror} || $ss->{source};
- my $path = "dists/$ss->{suite}/Release";
- my $url = "$src/$path";
- my $target = __url_to_filename ("$ss->{source}/$path");
- eval {
- $self->download ($url, "$infodir/$target");
- $self->download ("$url.gpg", "$infodir/$target.gpg");
- # fixme: impl. verify (needs --keyring option)
- };
- if (my $err = $@) {
- print $logfd $@;
- warn "Release info ignored\n";
- };
-
- foreach my $comp (@{$ss->{comp}}) {
- foreach my $compressor (@$COMPRESSORS) {
- $path = "dists/$ss->{suite}/$comp/binary-$arch/Packages.$compressor->{ext}";
- $target = "$infodir/" . __url_to_filename ("$ss->{source}/$path");
- my $pkgsrc = "$src/$path";
- eval {
- $self->download ($pkgsrc, $target);
- $self->run_command ("$compressor->{decomp} '$target'");
- };
- if (my $err = $@) {
- print $logfd "could not download Packages.$compressor->{ext}\n";
- } else {
- last;
- }
- }
- }
+ foreach my $ss (@{ $self->{sources} }) {
+ my $src = $ss->{mirror} || $ss->{source};
+ my $path = "dists/$ss->{suite}/Release";
+ my $url = "$src/$path";
+ my $target = __url_to_filename("$ss->{source}/$path");
+ eval {
+ $self->download($url, "$infodir/$target");
+ $self->download("$url.gpg", "$infodir/$target.gpg");
+ # fixme: impl. verify (needs --keyring option)
+ };
+ if (my $err = $@) {
+ print $logfd $@;
+ warn "Release info ignored\n";
+ }
+
+ foreach my $comp (@{ $ss->{comp} }) {
+ foreach my $compressor (@$COMPRESSORS) {
+ $path = "dists/$ss->{suite}/$comp/binary-$arch/Packages.$compressor->{ext}";
+ $target = "$infodir/" . __url_to_filename("$ss->{source}/$path");
+ my $pkgsrc = "$src/$path";
+ eval {
+ $self->download($pkgsrc, $target);
+ $self->run_command("$compressor->{decomp} '$target'");
+ };
+ if (my $err = $@) {
+ print $logfd "could not download Packages.$compressor->{ext}\n";
+ } else {
+ last;
+ }
+ }
+ }
}
}
@@ -670,7 +674,7 @@ sub write_config {
$data .= "Description: $config->{headline}\n";
$data .= "$config->{description}\n" if $config->{description};
- write_file ($data, $filename, 0644);
+ write_file($data, $filename, 0644);
}
sub finalize {
@@ -680,7 +684,7 @@ sub finalize {
my $infodir = $self->{infodir};
my $arch = $self->{config}->{architecture};
- my $instpkgs = $self->read_installed ();
+ my $instpkgs = $self->read_installed();
my $pkginfo = $self->pkginfo();
my $veid = $self->{veid};
my $conffile = $self->{veconffile};
@@ -691,113 +695,116 @@ sub finalize {
# cleanup mysqld
if (-f "$rootdir/etc/init.d/mysql") {
- $self->ve_command ("/etc/init.d/mysql stop");
+ $self->ve_command("/etc/init.d/mysql stop");
}
if (!($opts->{keepmycnf} || (-f "$rootdir/etc/init.d/mysql_randompw"))) {
- unlink "$rootdir/root/.my.cnf";
+ unlink "$rootdir/root/.my.cnf";
}
- $self->logmsg ("cleanup package status\n");
+ $self->logmsg("cleanup package status\n");
# prevent auto selection of all standard, required, or important packages which are not installed
foreach my $pkg (keys %$pkginfo) {
- my $pri = $pkginfo->{$pkg}->{priority};
- if ($pri && ($pri eq 'required' || $pri eq 'important' || $pri eq 'standard')) {
- if (!$instpkgs->{$pkg}) {
- $self->ve_dpkg_set_selection ($pkg, 'purge');
- }
- }
- }
-
- $self->ve_command ("apt-get clean");
-
- $self->logmsg ("update available package list\n");
-
- $self->ve_command ("dpkg --clear-avail");
- foreach my $ss (@{$self->{sources}}) {
- my $relsrc = __url_to_filename ("$ss->{source}/dists/$ss->{suite}/Release");
- if (-f "$infodir/$relsrc" && -f "$infodir/$relsrc.gpg") {
- $self->run_command ("cp '$infodir/$relsrc' '$rootdir/var/lib/apt/lists/$relsrc'");
- $self->run_command ("cp '$infodir/$relsrc.gpg' '$rootdir/var/lib/apt/lists/$relsrc.gpg'");
- }
- foreach my $comp (@{$ss->{comp}}) {
- my $src = __url_to_filename("$ss->{source}/dists/$ss->{suite}/${comp}/binary-${arch}/Packages");
- my $target = "/var/lib/apt/lists/$src";
- $self->run_command ("cp '$infodir/$src' '$rootdir/$target'");
- $self->ve_command ("dpkg --merge-avail '$target'");
- }
+ my $pri = $pkginfo->{$pkg}->{priority};
+ if ($pri && ($pri eq 'required' || $pri eq 'important' || $pri eq 'standard')) {
+ if (!$instpkgs->{$pkg}) {
+ $self->ve_dpkg_set_selection($pkg, 'purge');
+ }
+ }
+ }
+
+ $self->ve_command("apt-get clean");
+
+ $self->logmsg("update available package list\n");
+
+ $self->ve_command("dpkg --clear-avail");
+ foreach my $ss (@{ $self->{sources} }) {
+ my $relsrc = __url_to_filename("$ss->{source}/dists/$ss->{suite}/Release");
+ if (-f "$infodir/$relsrc" && -f "$infodir/$relsrc.gpg") {
+ $self->run_command("cp '$infodir/$relsrc' '$rootdir/var/lib/apt/lists/$relsrc'");
+ $self->run_command(
+ "cp '$infodir/$relsrc.gpg' '$rootdir/var/lib/apt/lists/$relsrc.gpg'");
+ }
+ foreach my $comp (@{ $ss->{comp} }) {
+ my $src = __url_to_filename(
+ "$ss->{source}/dists/$ss->{suite}/${comp}/binary-${arch}/Packages");
+ my $target = "/var/lib/apt/lists/$src";
+ $self->run_command("cp '$infodir/$src' '$rootdir/$target'");
+ $self->ve_command("dpkg --merge-avail '$target'");
+ }
}
# set dselect default method
- write_file ("apt apt\n", "$rootdir/var/lib/dpkg/cmethopt");
+ write_file("apt apt\n", "$rootdir/var/lib/dpkg/cmethopt");
- $self->ve_divert_remove ("/usr/sbin/policy-rc.d");
+ $self->ve_divert_remove("/usr/sbin/policy-rc.d");
- $self->ve_divert_remove ("/sbin/start-stop-daemon");
+ $self->ve_divert_remove("/sbin/start-stop-daemon");
- $self->ve_divert_remove ("/sbin/init");
+ $self->ve_divert_remove("/sbin/init");
# finally stop the VE
- $self->run_command ("lxc-stop -n $veid --rcfile $conffile --kill");
+ $self->run_command("lxc-stop -n $veid --rcfile $conffile --kill");
unlink "$rootdir/sbin/defenv";
unlink <$rootdir/root/dead.letter*>;
unlink "$rootdir/var/log/init.log";
unlink "$rootdir/aquota.group", "$rootdir/aquota.user";
- write_file ("", "$rootdir/var/log/syslog");
+ write_file("", "$rootdir/var/log/syslog");
my $get_path_size = sub {
- my ($path) = @_;
- my $sizestr = $self->run_command ("du -sm $path", undef, 1);
- if ($sizestr =~ m/^(\d+)\s+\Q$path\E$/) {
- return int($1);
- } else {
- die "unable to detect size for '$path'\n";
- }
+ my ($path) = @_;
+ my $sizestr = $self->run_command("du -sm $path", undef, 1);
+ if ($sizestr =~ m/^(\d+)\s+\Q$path\E$/) {
+ return int($1);
+ } else {
+ die "unable to detect size for '$path'\n";
+ }
};
- $self->logmsg ("detecting final appliance size: ");
+ $self->logmsg("detecting final appliance size: ");
my $size = $get_path_size->($rootdir);
- $self->logmsg ("$size MB\n");
+ $self->logmsg("$size MB\n");
- $self->write_config ("$rootdir/etc/appliance.info", $size);
+ $self->write_config("$rootdir/etc/appliance.info", $size);
- $self->logmsg ("creating final appliance archive\n");
+ $self->logmsg("creating final appliance archive\n");
my $target = "$self->{targetname}.tar";
my $compressor = $opts->{compressor} // 'gz';
my $compressor2cmd_map = {
- gz => 'gzip',
- gzip => 'gzip',
- zst => 'zstd --rm -9',
- zstd => 'zstd --rm -9',
- 'zstd-max' => 'zstd --rm -19 -T0', # maximal level where the decompressor can still run efficiently
+ gz => 'gzip',
+ gzip => 'gzip',
+ zst => 'zstd --rm -9',
+ zstd => 'zstd --rm -9',
+ 'zstd-max' => 'zstd --rm -19 -T0', # maximal level where the decompressor can still run efficiently
};
my $compressor2ending = {
- gzip => 'gz',
- zstd => 'zst',
- 'zstd-max' => 'zst',
+ gzip => 'gz',
+ zstd => 'zst',
+ 'zstd-max' => 'zst',
};
my $compressor_cmd = $compressor2cmd_map->{$compressor};
- die "unkown compressor '$compressor', use one of: ". join(', ', sort keys %$compressor2cmd_map)
- if !defined($compressor_cmd);
+ die "unkown compressor '$compressor', use one of: " . join(', ', sort keys %$compressor2cmd_map)
+ if !defined($compressor_cmd);
my $ending = $compressor2ending->{$compressor} // $compressor;
my $final_archive = "${target}.${ending}";
unlink $target;
unlink $final_archive;
- $self->run_command ("tar cpf $target --numeric-owner -C '$rootdir' ./etc/appliance.info");
- $self->run_command ("tar rpf $target --numeric-owner -C '$rootdir' --exclude ./etc/appliance.info .");
- $self->run_command ("$compressor_cmd $target");
+ $self->run_command("tar cpf $target --numeric-owner -C '$rootdir' ./etc/appliance.info");
+ $self->run_command(
+ "tar rpf $target --numeric-owner -C '$rootdir' --exclude ./etc/appliance.info .");
+ $self->run_command("$compressor_cmd $target");
- $self->logmsg ("detecting final commpressed appliance size: ");
+ $self->logmsg("detecting final commpressed appliance size: ");
$size = $get_path_size->($final_archive);
- $self->logmsg ("$size MB\n");
+ $self->logmsg("$size MB\n");
- $self->logmsg ("appliance archive: $final_archive\n");
+ $self->logmsg("appliance archive: $final_archive\n");
}
sub read_installed {
@@ -812,26 +819,26 @@ sub read_installed {
my $pkglist = {};
while (my $rec = <$PKGLST>) {
- chomp $rec;
- $rec =~ s/\n\s+/ /g;
- $rec .= "\n";
- my $res = {};
+ chomp $rec;
+ $rec =~ s/\n\s+/ /g;
+ $rec .= "\n";
+ my $res = {};
- while ($rec =~ s/^([^:]+):\s+(.*?)\s*\n//) {
- $res->{lc $1} = $2;
- }
+ while ($rec =~ s/^([^:]+):\s+(.*?)\s*\n//) {
+ $res->{ lc $1 } = $2;
+ }
- my $pkg = $res->{'package'};
- if (my $status = $res->{status}) {
- my @sa = split (/\s+/, $status);
- my $stat = $sa[0];
- if ($stat && ($stat ne 'purge')) {
- $pkglist->{$pkg} = $res;
- }
- }
+ my $pkg = $res->{'package'};
+ if (my $status = $res->{status}) {
+ my @sa = split(/\s+/, $status);
+ my $stat = $sa[0];
+ if ($stat && ($stat ne 'purge')) {
+ $pkglist->{$pkg} = $res;
+ }
+ }
}
- close ($PKGLST);
+ close($PKGLST);
return $pkglist;
}
@@ -848,16 +855,16 @@ sub ve_status {
my $filename = "/proc/net/unix";
# similar test is used by lcxcontainers.c: list_active_containers
- my $fh = IO::File->new ($filename, "r");
+ my $fh = IO::File->new($filename, "r");
return $res if !$fh;
while (defined(my $line = <$fh>)) {
- if ($line =~ m/^[a-f0-9]+:\s\S+\s\S+\s\S+\s\S+\s\S+\s\d+\s(\S+)$/) {
- my $path = $1;
- if ($path =~ m!^@/\S+/$veid/command$!) {
- $res->{running} = 1;
- }
- }
+ if ($line =~ m/^[a-f0-9]+:\s\S+\s\S+\s\S+\s\S+\s\S+\s\d+\s(\S+)$/) {
+ my $path = $1;
+ if ($path =~ m!^@/\S+/$veid/command$!) {
+ $res->{running} = 1;
+ }
+ }
}
close($fh);
@@ -870,11 +877,14 @@ sub ve_command {
my $veid = $self->{veid};
my $conffile = $self->{veconffile};
- if (ref ($cmd) eq 'ARRAY') {
- unshift @$cmd, 'lxc-attach', '-n', $veid, '--rcfile', $conffile, '--clear-env', '--', 'defenv';
- $self->run_command($cmd, $input);
+ if (ref($cmd) eq 'ARRAY') {
+ unshift @$cmd, 'lxc-attach', '-n', $veid, '--rcfile', $conffile, '--clear-env', '--',
+ 'defenv';
+ $self->run_command($cmd, $input);
} else {
- $self->run_command("lxc-attach -n $veid --rcfile $conffile --clear-env -- defenv $cmd", $input);
+ $self->run_command(
+ "lxc-attach -n $veid --rcfile $conffile --clear-env -- defenv $cmd", $input,
+ );
}
}
@@ -886,14 +896,24 @@ sub ve_exec {
my $conffile = $self->{veconffile};
my $reader;
- my $pid = open2($reader, "<&STDIN", 'lxc-attach', '-n', $veid, '--rcfile', $conffile, '--',
- 'defenv', @cmd) || die "unable to exec command";
-
- while (defined (my $line = <$reader>)) {
- $self->logmsg ($line);
- }
-
- waitpid ($pid, 0);
+ my $pid = open2(
+ $reader,
+ "<&STDIN",
+ 'lxc-attach',
+ '-n',
+ $veid,
+ '--rcfile',
+ $conffile,
+ '--',
+ 'defenv',
+ @cmd,
+ ) || die "unable to exec command";
+
+ while (defined(my $line = <$reader>)) {
+ $self->logmsg($line);
+ }
+
+ waitpid($pid, 0);
my $rc = $? >> 8;
die "ve_exec failed - status $rc\n" if $rc != 0;
@@ -904,13 +924,14 @@ sub ve_divert_add {
$self->ve_command("dpkg-divert --add --divert '$filename.distrib' --rename '$filename'");
}
+
sub ve_divert_remove {
my ($self, $filename) = @_;
my $rootdir = $self->{rootfs};
unlink "$rootdir/$filename";
- $self->ve_command ("dpkg-divert --remove --rename '$filename'");
+ $self->ve_command("dpkg-divert --remove --rename '$filename'");
}
sub ve_debconfig_set {
@@ -918,21 +939,21 @@ sub ve_debconfig_set {
my $rootdir = $self->{rootfs};
my $cfgfile = "/tmp/debconf.txt";
- write_file ($dcdata, "$rootdir/$cfgfile");
- $self->ve_command ("debconf-set-selections $cfgfile");
- unlink "$rootdir/$cfgfile";
+ write_file($dcdata, "$rootdir/$cfgfile");
+ $self->ve_command("debconf-set-selections $cfgfile");
+ unlink "$rootdir/$cfgfile";
}
sub ve_dpkg_set_selection {
my ($self, $pkg, $status) = @_;
- $self->ve_command ("dpkg --set-selections", "$pkg $status");
+ $self->ve_command("dpkg --set-selections", "$pkg $status");
}
sub ve_dpkg {
my ($self, $cmd, @pkglist) = @_;
- return if !scalar (@pkglist);
+ return if !scalar(@pkglist);
my $pkginfo = $self->pkginfo();
@@ -942,20 +963,20 @@ sub ve_dpkg {
my @files;
foreach my $pkg (@pkglist) {
- my $filename = $self->getpkgfile ($pkg);
- $self->run_command ("cp '$cachedir/$filename' '$rootdir/$filename'");
- push @files, "/$filename";
- $self->logmsg ("$cmd: $pkg\n");
+ my $filename = $self->getpkgfile($pkg);
+ $self->run_command("cp '$cachedir/$filename' '$rootdir/$filename'");
+ push @files, "/$filename";
+ $self->logmsg("$cmd: $pkg\n");
}
- my $fl = join (' ', @files);
+ my $fl = join(' ', @files);
if ($cmd eq 'install') {
- $self->ve_command ("dpkg --force-depends --force-confold --install $fl");
+ $self->ve_command("dpkg --force-depends --force-confold --install $fl");
} elsif ($cmd eq 'unpack') {
- $self->ve_command ("dpkg --force-depends --unpack $fl");
+ $self->ve_command("dpkg --force-depends --unpack $fl");
} else {
- die "internal error";
+ die "internal error";
}
foreach my $fn (@files) { unlink "$rootdir$fn"; }
@@ -969,7 +990,7 @@ sub ve_destroy {
my $vestat = $self->ve_status();
if ($vestat->{running}) {
- $self->run_command ("lxc-stop -n $veid --rcfile $conffile --kill");
+ $self->run_command("lxc-stop -n $veid --rcfile $conffile --kill");
}
rmtree $self->{rootfs};
@@ -982,12 +1003,12 @@ sub ve_init {
my $veid = $self->{veid};
my $conffile = $self->{veconffile};
- $self->logmsg ("initialize VE $veid\n");
+ $self->logmsg("initialize VE $veid\n");
my $vestat = $self->ve_status();
if ($vestat->{running}) {
- $self->run_command ("lxc-stop -n $veid --rcfile $conffile --kill");
- }
+ $self->run_command("lxc-stop -n $veid --rcfile $conffile --kill");
+ }
rmtree $self->{rootfs};
mkpath $self->{rootfs};
@@ -997,7 +1018,7 @@ sub __deb_version_cmp {
my ($cur, $op, $new) = @_;
if (system("dpkg", "--compare-versions", $cur, $op, $new) == 0) {
- return 1;
+ return 1;
}
return 0;
@@ -1010,35 +1031,35 @@ sub __parse_packages {
open(my $PKGLST, '<', $filename) or die "unable to open '$filename' - $!";
while (my $rec = <$PKGLST>) {
- $rec =~ s/\n\s+/ /g;
- chomp $rec;
- $rec .= "\n";
-
- my $res = {};
-
- while ($rec =~ s/^([^:]+):\s+(.*?)\s*\n//) {
- $res->{lc $1} = $2;
- }
-
- my $pkg = $res->{'package'};
- if ($pkg && $res->{'filename'}) {
- my $cur;
- if (my $info = $pkginfo->{$pkg}) {
- $cur = $info->{version};
- }
- my $new = $res->{version};
- if (!$cur || __deb_version_cmp ($cur, 'lt', $new)) {
- if ($src) {
- $res->{url} = "$src/$res->{'filename'}";
- } else {
- die "no url for package '$pkg'" if !$res->{url};
- }
- $pkginfo->{$pkg} = $res;
- }
- }
- }
-
- close ($PKGLST);
+ $rec =~ s/\n\s+/ /g;
+ chomp $rec;
+ $rec .= "\n";
+
+ my $res = {};
+
+ while ($rec =~ s/^([^:]+):\s+(.*?)\s*\n//) {
+ $res->{ lc $1 } = $2;
+ }
+
+ my $pkg = $res->{'package'};
+ if ($pkg && $res->{'filename'}) {
+ my $cur;
+ if (my $info = $pkginfo->{$pkg}) {
+ $cur = $info->{version};
+ }
+ my $new = $res->{version};
+ if (!$cur || __deb_version_cmp($cur, 'lt', $new)) {
+ if ($src) {
+ $res->{url} = "$src/$res->{'filename'}";
+ } else {
+ die "no url for package '$pkg'" if !$res->{url};
+ }
+ $pkginfo->{$pkg} = $res;
+ }
+ }
+ }
+
+ close($PKGLST);
}
sub pkginfo {
@@ -1057,62 +1078,62 @@ sub pkginfo {
# reading 'available' is faster, because it only contains latest version
# (no need to do slow version compares)
if (-f $availfn) {
- __parse_packages ($pkginfo, $availfn);
- $self->{pkginfo} = $pkginfo;
- return $pkginfo;
+ __parse_packages($pkginfo, $availfn);
+ $self->{pkginfo} = $pkginfo;
+ return $pkginfo;
}
- $self->logmsg ("generating available package list\n");
+ $self->logmsg("generating available package list\n");
- foreach my $ss (@{$self->{sources}}) {
- foreach my $comp (@{$ss->{comp}}) {
- my $url = "$ss->{source}/dists/$ss->{suite}/$comp/binary-$arch/Packages";
- my $pkgfilelist = "$infodir/" . __url_to_filename ($url);
+ foreach my $ss (@{ $self->{sources} }) {
+ foreach my $comp (@{ $ss->{comp} }) {
+ my $url = "$ss->{source}/dists/$ss->{suite}/$comp/binary-$arch/Packages";
+ my $pkgfilelist = "$infodir/" . __url_to_filename($url);
- my $src = $ss->{mirror} || $ss->{source};
+ my $src = $ss->{mirror} || $ss->{source};
- __parse_packages ($pkginfo, $pkgfilelist, $src);
- }
+ __parse_packages($pkginfo, $pkgfilelist, $src);
+ }
}
if (my $dep = $self->{config}->{depends}) {
- foreach my $d (split (/,/, $dep)) {
- if ($d =~ m/^\s*(\S+)\s*(\((\S+)\s+(\S+)\)\s*)?$/) {
- my ($pkg, $op, $rver) = ($1, $3, $4);
- $self->logmsg ("checking dependencies: $d\n");
- my $info = $pkginfo->{$pkg};
- die "package '$pkg' not available\n" if !$info;
- if ($op) {
- my $cver = $info->{version};
- if (!__deb_version_cmp ($cver, $op, $rver)) {
- die "detected wrong version '$cver'\n";
- }
- }
- } else {
- die "syntax error in depends field";
- }
- }
+ foreach my $d (split(/,/, $dep)) {
+ if ($d =~ m/^\s*(\S+)\s*(\((\S+)\s+(\S+)\)\s*)?$/) {
+ my ($pkg, $op, $rver) = ($1, $3, $4);
+ $self->logmsg("checking dependencies: $d\n");
+ my $info = $pkginfo->{$pkg};
+ die "package '$pkg' not available\n" if !$info;
+ if ($op) {
+ my $cver = $info->{version};
+ if (!__deb_version_cmp($cver, $op, $rver)) {
+ die "detected wrong version '$cver'\n";
+ }
+ }
+ } else {
+ die "syntax error in depends field";
+ }
+ }
}
$self->{pkginfo} = $pkginfo;
my $tmpfn = "$availfn.tmp$$";
- my $fd = IO::File->new (">$tmpfn");
+ my $fd = IO::File->new(">$tmpfn");
foreach my $pkg (sort keys %$pkginfo) {
- my $info = $pkginfo->{$pkg};
- print $fd "package: $pkg\n";
- foreach my $k (sort keys %$info) {
- next if $k eq 'description';
- next if $k eq 'package';
- my $v = $info->{$k};
- print $fd "$k: $v\n" if $v;
- }
- print $fd "description: $info->{description}\n" if $info->{description};
- print $fd "\n";
+ my $info = $pkginfo->{$pkg};
+ print $fd "package: $pkg\n";
+ foreach my $k (sort keys %$info) {
+ next if $k eq 'description';
+ next if $k eq 'package';
+ my $v = $info->{$k};
+ print $fd "$k: $v\n" if $v;
+ }
+ print $fd "description: $info->{description}\n" if $info->{description};
+ print $fd "\n";
}
- close ($fd);
+ close($fd);
- rename ($tmpfn, $availfn);
+ rename($tmpfn, $availfn);
return $pkginfo;
}
@@ -1121,24 +1142,24 @@ sub __record_provides {
my ($pkginfo, $closure, $list, $skipself) = @_;
foreach my $pname (@$list) {
- my $info = $pkginfo->{$pname};
- # fixme: if someone install packages directly using dpkg, there
- # is no entry in 'available', only in 'status'. In that case, we
- # should extract info from $instpkgs
- if (!$info) {
- warn "hint: ignoring provides for '$pname' - package not in 'available' list.\n";
- next;
- }
- if (my $prov = $info->{provides}) {
- my @pl = split (',', $prov);
- foreach my $p (@pl) {
- $p =~ m/\s*(\S+)/;
- if (!($skipself && (grep { $1 eq $_ } @$list))) {
- $closure->{$1} = 1;
- }
- }
- }
- $closure->{$pname} = 1 if !$skipself;
+ my $info = $pkginfo->{$pname};
+ # fixme: if someone install packages directly using dpkg, there
+ # is no entry in 'available', only in 'status'. In that case, we
+ # should extract info from $instpkgs
+ if (!$info) {
+ warn "hint: ignoring provides for '$pname' - package not in 'available' list.\n";
+ next;
+ }
+ if (my $prov = $info->{provides}) {
+ my @pl = split(',', $prov);
+ foreach my $p (@pl) {
+ $p =~ m/\s*(\S+)/;
+ if (!($skipself && (grep { $1 eq $_ } @$list))) {
+ $closure->{$1} = 1;
+ }
+ }
+ }
+ $closure->{$pname} = 1 if !$skipself;
}
}
@@ -1148,14 +1169,14 @@ sub closure {
my $pkginfo = $self->pkginfo();
# first, record provided packages
- __record_provides ($pkginfo, $closure, $list, 1);
+ __record_provides($pkginfo, $closure, $list, 1);
my $pkghash = {};
my $pkglist = [];
# then resolve dependencies
foreach my $pname (@$list) {
- __closure_single ($pkginfo, $closure, $pkghash, $pkglist, $pname, $self->{excl});
+ __closure_single($pkginfo, $closure, $pkghash, $pkglist, $pname, $self->{excl});
}
return $pkglist;
@@ -1181,64 +1202,64 @@ sub __closure_single {
$url || die "$pname: no url for package '$pname'";
if (!$pkghash->{$pname}) {
- unshift @$pkglist, $pname;
- $pkghash->{$pname} = 1;
+ unshift @$pkglist, $pname;
+ $pkghash->{$pname} = 1;
}
- __record_provides ($pkginfo, $closure, [$pname]) if $info->{provides};
+ __record_provides($pkginfo, $closure, [$pname]) if $info->{provides};
$closure->{$pname} = 1;
-
+
#print "$url\n";
my @l;
- push @l, split (/,/, $predep) if $predep;
- push @l, split (/,/, $dep) if $dep;
-
- DEPEND: foreach my $p (@l) {
- my @l1 = split (/\|/, $p);
- foreach my $p1 (@l1) {
- if ($p1 =~ m/^\s*(\S+).*/) {
- #printf (STDERR "$pname: $p --> $1\n");
- if ($closure->{$1}) {
- next DEPEND; # dependency already met
- }
- }
- }
- # search for non-excluded alternative
- my $success;
- foreach my $p1 (@l1) {
- next unless $p1 =~ /^\s*(\S+)/;
- my $candidate = $1;
-
- next if grep { $candidate eq $_ } @$excl;
-
- #print STDERR "$pname: trying $candidate for '$p'\n";
-
- my $ok = eval {
- __closure_single($pkginfo, $closure, $pkghash, $pkglist, $candidate, $excl);
- 1;
- };
-
- if ($ok) {
- $success = 1;
- last;
- } else {
- print STDERR "$pname: $candidate failed, trying next alternative...\n";
- }
- }
-
- die "package '$pname' could not satisfy dependency '$p' (all alternatives failed)\n"
- unless $success;
- }
+ push @l, split(/,/, $predep) if $predep;
+ push @l, split(/,/, $dep) if $dep;
+
+DEPEND: foreach my $p (@l) {
+ my @l1 = split(/\|/, $p);
+ foreach my $p1 (@l1) {
+ if ($p1 =~ m/^\s*(\S+).*/) {
+ #printf (STDERR "$pname: $p --> $1\n");
+ if ($closure->{$1}) {
+ next DEPEND; # dependency already met
+ }
+ }
+ }
+ # search for non-excluded alternative
+ my $success;
+ foreach my $p1 (@l1) {
+ next unless $p1 =~ /^\s*(\S+)/;
+ my $candidate = $1;
+
+ next if grep { $candidate eq $_ } @$excl;
+
+ #print STDERR "$pname: trying $candidate for '$p'\n";
+
+ my $ok = eval {
+ __closure_single($pkginfo, $closure, $pkghash, $pkglist, $candidate, $excl);
+ 1;
+ };
+
+ if ($ok) {
+ $success = 1;
+ last;
+ } else {
+ print STDERR "$pname: $candidate failed, trying next alternative...\n";
+ }
+ }
+
+ die "package '$pname' could not satisfy dependency '$p' (all alternatives failed)\n"
+ unless $success;
+ }
}
sub cache_packages {
my ($self, $pkglist) = @_;
foreach my $pkg (@$pkglist) {
- $self->getpkgfile ($pkg);
+ $self->getpkgfile($pkg);
}
}
@@ -1253,16 +1274,16 @@ sub getpkgfile {
my $filename;
if ($url =~ m|/([^/]+.deb)$|) {
- $filename = $1;
+ $filename = $1;
} else {
- die "internal error";
+ die "internal error";
}
return $filename if -f "$cachedir/$filename";
mkpath $cachedir;
- $self->download ($url, "$cachedir/$filename");
+ $self->download($url, "$cachedir/$filename");
return $filename;
}
@@ -1274,16 +1295,16 @@ sub install_init_script {
my $suiteinfo = get_suite_info($suite);
my $rootdir = $self->{rootfs};
- my $base = basename ($script);
+ my $base = basename($script);
my $target = "$rootdir/etc/init.d/$base";
- $self->run_command ("install -m 0755 '$script' '$target'");
+ $self->run_command("install -m 0755 '$script' '$target'");
if ($suiteinfo->{systemd}) {
- die "unable to install init script (system uses systemd)\n";
+ die "unable to install init script (system uses systemd)\n";
} elsif ($suite eq 'trusty' || $suite eq 'precise') {
- die "unable to install init script (system uses upstart)\n";
+ die "unable to install init script (system uses upstart)\n";
} else {
- $self->ve_command ("insserv $base");
+ $self->ve_command("insserv $base");
}
return $target;
@@ -1304,7 +1325,7 @@ sub bootstrap {
my $suite = $self->{config}->{suite};
my $suiteinfo = get_suite_info($suite);
- my $important = [ @{$self->{incl}} ];
+ my $important = [@{ $self->{incl} }];
my $required;
my $standard;
@@ -1319,11 +1340,11 @@ sub bootstrap {
'openssh-server' => 1,
);
- @{ $important } = grep { !$remove{$_} } @{ $important };
+ @{$important} = grep { !$remove{$_} } @{$important};
}
my $mta = $opts->{mta} ? $opts->{mta} : "postfix";
-
+
# Maintain compatibility with `--exim` flag
if ($opts->{exim}) {
$mta = "exim";
@@ -1334,25 +1355,25 @@ sub bootstrap {
}
if ($opts->{include}) {
- push @$important, split(',', $opts->{include});
+ push @$important, split(',', $opts->{include});
}
my $exclude = {};
if ($opts->{exclude}) {
- $exclude->{$_} = 1 for split(',', $opts->{exclude});
+ $exclude->{$_} = 1 for split(',', $opts->{exclude});
}
foreach my $p (sort keys %$pkginfo) {
- next if grep { $p eq $_ } @{$self->{excl}};
- my $pri = $pkginfo->{$p}->{priority};
- next if !$pri;
- next if $mta ne 'exim' && $p =~ m/exim/;
- next if $p =~ m/(selinux|semanage|policycoreutils)/;
+ next if grep { $p eq $_ } @{ $self->{excl} };
+ my $pri = $pkginfo->{$p}->{priority};
+ next if !$pri;
+ next if $mta ne 'exim' && $p =~ m/exim/;
+ next if $p =~ m/(selinux|semanage|policycoreutils)/;
- push @$required, $p if $pri eq 'required';
- next if $exclude->{$p};
- push @$important, $p if $pri eq 'important';
- push @$standard, $p if $pri eq 'standard' && !$opts->{minimal};
+ push @$required, $p if $pri eq 'required';
+ next if $exclude->{$p};
+ push @$important, $p if $pri eq 'important';
+ push @$standard, $p if $pri eq 'standard' && !$opts->{minimal};
}
my $closure = {};
@@ -1360,277 +1381,282 @@ sub bootstrap {
$important = $self->closure($closure, $important);
if (!$opts->{minimal}) {
- $standard = $self->closure($closure, $standard);
+ $standard = $self->closure($closure, $standard);
}
# test if we have all 'ubuntu-minimal' and 'ubuntu-standard' packages
# except those explicitly excluded
if ($suite eq 'hardy' || $suite eq 'intrepid' || $suite eq 'jaunty') {
- my $mdeps = $pkginfo->{'ubuntu-minimal'}->{depends};
- foreach my $d (split (/,/, $mdeps)) {
- if ($d =~ m/^\s*(\S+)$/) {
- my $pkg = $1;
- next if $closure->{$pkg};
- next if grep { $pkg eq $_ } @{$self->{excl}};
- die "missing ubuntu-minimal package '$pkg'\n";
- }
- }
- if (!$opts->{minimal}) {
- $mdeps = $pkginfo->{'ubuntu-standard'}->{depends};
- foreach my $d (split (/,/, $mdeps)) {
- if ($d =~ m/^\s*(\S+)$/) {
- my $pkg = $1;
- next if $closure->{$pkg};
- next if grep { $pkg eq $_ } @{$self->{excl}};
- die "missing ubuntu-standard package '$pkg'\n";
- }
- }
- }
+ my $mdeps = $pkginfo->{'ubuntu-minimal'}->{depends};
+ foreach my $d (split(/,/, $mdeps)) {
+ if ($d =~ m/^\s*(\S+)$/) {
+ my $pkg = $1;
+ next if $closure->{$pkg};
+ next if grep { $pkg eq $_ } @{ $self->{excl} };
+ die "missing ubuntu-minimal package '$pkg'\n";
+ }
+ }
+ if (!$opts->{minimal}) {
+ $mdeps = $pkginfo->{'ubuntu-standard'}->{depends};
+ foreach my $d (split(/,/, $mdeps)) {
+ if ($d =~ m/^\s*(\S+)$/) {
+ my $pkg = $1;
+ next if $closure->{$pkg};
+ next if grep { $pkg eq $_ } @{ $self->{excl} };
+ die "missing ubuntu-standard package '$pkg'\n";
+ }
+ }
+ }
}
# download/cache all files first
- $self->cache_packages ($required);
- $self->cache_packages ($important);
- $self->cache_packages ($standard);
-
+ $self->cache_packages($required);
+ $self->cache_packages($important);
+ $self->cache_packages($standard);
+
my $rootdir = $self->{rootfs};
# extract required packages first
- $self->logmsg ("create basic environment\n");
+ $self->logmsg("create basic environment\n");
if ($self->can_usr_merge()) {
- $self->setup_usr_merge();
+ $self->setup_usr_merge();
}
my $compressor2opt = {
- 'zst' => '--zstd',
- 'gz' => '--gzip',
- 'xz' => '--xz',
+ 'zst' => '--zstd',
+ 'gz' => '--gzip',
+ 'xz' => '--xz',
};
my $compressor_re = join('|', keys $compressor2opt->%*);
- $self->logmsg ("extract required packages to rootfs\n");
+ $self->logmsg("extract required packages to rootfs\n");
foreach my $p (@$required) {
- my $filename = $self->getpkgfile ($p);
- my $content = $self->run_command("ar -t '$self->{cachedir}/$filename'", undef, 1);
- if ($content =~ m/^(data.tar.($compressor_re))$/m) {
- my $archive = $1;
- my $tar_opts = "--keep-directory-symlink $compressor2opt->{$2}";
+ my $filename = $self->getpkgfile($p);
+ my $content = $self->run_command("ar -t '$self->{cachedir}/$filename'", undef, 1);
+ if ($content =~ m/^(data.tar.($compressor_re))$/m) {
+ my $archive = $1;
+ my $tar_opts = "--keep-directory-symlink $compressor2opt->{$2}";
- $self->run_command("ar -p '$self->{cachedir}/$filename' '$archive' | tar -C '$rootdir' -xf - $tar_opts");
- } else {
- die "unexpected error for $p: no data.tar.{xz,gz,zst} found...";
- }
+ $self->run_command(
+ "ar -p '$self->{cachedir}/$filename' '$archive' | tar -C '$rootdir' -xf - $tar_opts"
+ );
+ } else {
+ die "unexpected error for $p: no data.tar.{xz,gz,zst} found...";
+ }
}
# fake dpkg status
- my $data = "Package: dpkg\n" .
- "Version: $pkginfo->{dpkg}->{version}\n" .
- "Status: install ok installed\n";
+ my $data =
+ "Package: dpkg\n"
+ . "Version: $pkginfo->{dpkg}->{version}\n"
+ . "Status: install ok installed\n";
- write_file ($data, "$rootdir/var/lib/dpkg/status");
- write_file ("", "$rootdir/var/lib/dpkg/info/dpkg.list");
- write_file ("", "$rootdir/var/lib/dpkg/available");
+ write_file($data, "$rootdir/var/lib/dpkg/status");
+ write_file("", "$rootdir/var/lib/dpkg/info/dpkg.list");
+ write_file("", "$rootdir/var/lib/dpkg/available");
$data = '';
if ($suiteinfo->{modern_apt_sources}) {
- mkdir "$rootdir/etc/apt/sources.list.d";
- my $origin = lc($suiteinfo->{origin});
- my $keyring = $suiteinfo->{keyring} or die "missing keyring for origin '$origin'";
- my @keep_sources = grep { $_->{keep} } $self->{sources}->@*;
- my $uris = { map { $_->{source} => 1 } @keep_sources };
-
- for my $uri (keys $uris->%*) {
- my $sources = [ grep { $_->{source} eq $uri } $self->{sources}->@* ];
-
- my $suites = join(' ', (map { $_->{suite} } $sources->@*));
- my $unique_components = { map { $_ => 1 } (map { $_->{comp}->@* } $sources->@*) };
- my $components = join(' ', (sort keys $unique_components->%*));
-
- $data .= "\n" if $data ne '';
- $data .= "Types: deb\n";
- $data .= "URIs: $uri\n";
- $data .= "Suites: $suites\n";
- $data .= "Components: $components\n";
- $data .= "Signed-By: $keyring\n";
- }
-
- write_file($data, "$rootdir/etc/apt/sources.list.d/${origin}.sources");
+ mkdir "$rootdir/etc/apt/sources.list.d";
+ my $origin = lc($suiteinfo->{origin});
+ my $keyring = $suiteinfo->{keyring} or die "missing keyring for origin '$origin'";
+ my @keep_sources = grep { $_->{keep} } $self->{sources}->@*;
+ my $uris = { map { $_->{source} => 1 } @keep_sources };
+
+ for my $uri (keys $uris->%*) {
+ my $sources = [grep { $_->{source} eq $uri } $self->{sources}->@*];
+
+ my $suites = join(' ', (map { $_->{suite} } $sources->@*));
+ my $unique_components = { map { $_ => 1 } (map { $_->{comp}->@* } $sources->@*) };
+ my $components = join(' ', (sort keys $unique_components->%*));
+
+ $data .= "\n" if $data ne '';
+ $data .= "Types: deb\n";
+ $data .= "URIs: $uri\n";
+ $data .= "Suites: $suites\n";
+ $data .= "Components: $components\n";
+ $data .= "Signed-By: $keyring\n";
+ }
+
+ write_file($data, "$rootdir/etc/apt/sources.list.d/${origin}.sources");
} else {
- foreach my $ss (@{$self->{sources}}) {
- my $url = $ss->{source};
- my $comp = join (' ', @{$ss->{comp}});
- $data .= "deb $url $ss->{suite} $comp\n\n";
- }
+ foreach my $ss (@{ $self->{sources} }) {
+ my $url = $ss->{source};
+ my $comp = join(' ', @{ $ss->{comp} });
+ $data .= "deb $url $ss->{suite} $comp\n\n";
+ }
- write_file ($data, "$rootdir/etc/apt/sources.list");
+ write_file($data, "$rootdir/etc/apt/sources.list");
}
$data = "# UNCONFIGURED FSTAB FOR BASE SYSTEM\n";
- write_file ($data, "$rootdir/etc/fstab", 0644);
+ write_file($data, "$rootdir/etc/fstab", 0644);
- write_file ("localhost\n", "$rootdir/etc/hostname", 0644);
+ write_file("localhost\n", "$rootdir/etc/hostname", 0644);
# avoid warnings about non-existent resolv.conf
- write_file ("", "$rootdir/etc/resolv.conf", 0644);
+ write_file("", "$rootdir/etc/resolv.conf", 0644);
if (lc($suiteinfo->{origin}) eq 'ubuntu' && $suiteinfo->{systemd}) {
- # no need to configure loopback device
- # FIXME: Debian (systemd based?) too?
+ # no need to configure loopback device
+ # FIXME: Debian (systemd based?) too?
} else {
- $data = "auto lo\niface lo inet loopback\n";
- mkdir "$rootdir/etc/network";
- write_file ($data, "$rootdir/etc/network/interfaces", 0644);
+ $data = "auto lo\niface lo inet loopback\n";
+ mkdir "$rootdir/etc/network";
+ write_file($data, "$rootdir/etc/network/interfaces", 0644);
}
# setup devices
- $self->run_command ("tar xzf '$devicetar' -C '$rootdir'") if $opts->{'device-skelleton'};
+ $self->run_command("tar xzf '$devicetar' -C '$rootdir'") if $opts->{'device-skelleton'};
# avoid warnings about missing default locale
- write_file ("LANG=\"C\"\n", "$rootdir/etc/default/locale", 0644);
+ write_file("LANG=\"C\"\n", "$rootdir/etc/default/locale", 0644);
# fake init
- rename ("$rootdir/sbin/init", "$rootdir/sbin/init.org")
+ rename("$rootdir/sbin/init", "$rootdir/sbin/init.org")
or die "failed to backup distro 'init' for manual diversion - $!";
- $self->run_command ("cp '$fake_init' '$rootdir/sbin/init'");
+ $self->run_command("cp '$fake_init' '$rootdir/sbin/init'");
- $self->run_command ("cp '$default_env' '$rootdir/sbin/defenv'");
+ $self->run_command("cp '$default_env' '$rootdir/sbin/defenv'");
- $self->run_command ("lxc-start -n $veid -f $self->{veconffile}");
+ $self->run_command("lxc-start -n $veid -f $self->{veconffile}");
- $self->logmsg ("initialize ld cache\n");
- $self->ve_command ("/sbin/ldconfig");
- $self->run_command ("ln -sf mawk '$rootdir/usr/bin/awk'");
+ $self->logmsg("initialize ld cache\n");
+ $self->ve_command("/sbin/ldconfig");
+ $self->run_command("ln -sf mawk '$rootdir/usr/bin/awk'");
- $self->logmsg ("installing packages\n");
+ $self->logmsg("installing packages\n");
- $self->ve_dpkg ('install', 'base-files', 'base-passwd');
+ $self->ve_dpkg('install', 'base-files', 'base-passwd');
- $self->ve_dpkg ('install', 'dpkg');
+ $self->ve_dpkg('install', 'dpkg');
- $self->run_command ("ln -sf /usr/share/zoneinfo/UTC '$rootdir/etc/localtime'");
+ $self->run_command("ln -sf /usr/share/zoneinfo/UTC '$rootdir/etc/localtime'");
- $self->run_command ("ln -sf bash '$rootdir/bin/sh'");
+ $self->run_command("ln -sf bash '$rootdir/bin/sh'");
- $self->ve_dpkg ('install', 'libc6');
- $self->ve_dpkg ('install', 'perl-base');
+ $self->ve_dpkg('install', 'libc6');
+ $self->ve_dpkg('install', 'perl-base');
unlink "$rootdir/usr/bin/awk";
- $self->ve_dpkg ('install', 'mawk');
- $self->ve_dpkg ('install', 'debconf');
+ $self->ve_dpkg('install', 'mawk');
+ $self->ve_dpkg('install', 'debconf');
# unpack required packages
foreach my $p (@$required) {
- $self->ve_dpkg ('unpack', $p);
+ $self->ve_dpkg('unpack', $p);
}
- rename ("$rootdir/sbin/init.org", "$rootdir/sbin/init")
- or die "failed to restore distro 'init' for actual diversion - $!";
- $self->ve_divert_add ("/sbin/init");
- $self->run_command ("cp '$fake_init' '$rootdir/sbin/init'");
+ rename("$rootdir/sbin/init.org", "$rootdir/sbin/init")
+ or die "failed to restore distro 'init' for actual diversion - $!";
+ $self->ve_divert_add("/sbin/init");
+ $self->run_command("cp '$fake_init' '$rootdir/sbin/init'");
# disable service activation
- $self->ve_divert_add ("/usr/sbin/policy-rc.d");
+ $self->ve_divert_add("/usr/sbin/policy-rc.d");
$data = "#!/bin/sh\nexit 101\n";
- write_file ($data, "$rootdir/usr/sbin/policy-rc.d", 755);
+ write_file($data, "$rootdir/usr/sbin/policy-rc.d", 755);
# disable start-stop-daemon
- $self->ve_divert_add ("/sbin/start-stop-daemon");
+ $self->ve_divert_add("/sbin/start-stop-daemon");
$data = <<EOD;
#!/bin/sh
echo
echo \"Warning: Fake start-stop-daemon called, doing nothing\"
EOD
- write_file ($data, "$rootdir/sbin/start-stop-daemon", 0755);
+ write_file($data, "$rootdir/sbin/start-stop-daemon", 0755);
# disable udevd
- $self->ve_divert_add ("/sbin/udevd");
+ $self->ve_divert_add("/sbin/udevd");
if ($suite eq 'etch') {
- write_file ("NO_START=1\n", "$rootdir/etc/default/apache2"); # disable apache2 startup
+ write_file("NO_START=1\n", "$rootdir/etc/default/apache2"); # disable apache2 startup
}
- $self->logmsg ("configure required packages\n");
- $self->ve_command ("dpkg --force-confold --skip-same-version --configure -a");
+ $self->logmsg("configure required packages\n");
+ $self->ve_command("dpkg --force-confold --skip-same-version --configure -a");
# set postfix defaults
if ($mta eq 'postfix') {
- $data = "postfix postfix/main_mailer_type select Local only\n";
- $self->ve_debconfig_set ($data);
+ $data = "postfix postfix/main_mailer_type select Local only\n";
+ $self->ve_debconfig_set($data);
- $data = "postmaster: root\nwebmaster: root\n";
- write_file ($data, "$rootdir/etc/aliases");
+ $data = "postmaster: root\nwebmaster: root\n";
+ write_file($data, "$rootdir/etc/aliases");
}
if ($suite eq 'jaunty') {
- # jaunty does not create /var/run/network, so network startup fails.
- # so we do not use tmpfs for /var/run and /var/lock
- $self->run_command ("sed -e 's/RAMRUN=yes/RAMRUN=no/' -e 's/RAMLOCK=yes/RAMLOCK=no/' -i $rootdir/etc/default/rcS");
- # and create the directory here
- $self->run_command ("mkdir $rootdir/var/run/network");
+ # jaunty does not create /var/run/network, so network startup fails.
+ # so we do not use tmpfs for /var/run and /var/lock
+ $self->run_command(
+ "sed -e 's/RAMRUN=yes/RAMRUN=no/' -e 's/RAMLOCK=yes/RAMLOCK=no/' -i $rootdir/etc/default/rcS"
+ );
+ # and create the directory here
+ $self->run_command("mkdir $rootdir/var/run/network");
}
# unpack base packages
foreach my $p (@$important) {
- $self->ve_dpkg ('unpack', $p);
+ $self->ve_dpkg('unpack', $p);
}
# start loopback
if (-x "$rootdir/sbin/ifconfig") {
- $self->ve_command ("ifconfig lo up");
+ $self->ve_command("ifconfig lo up");
} else {
- $self->ve_command ("ip link set lo up");
+ $self->ve_command("ip link set lo up");
}
- $self->logmsg ("configure important packages\n");
- $self->ve_command ("dpkg --force-confold --skip-same-version --configure -a");
+ $self->logmsg("configure important packages\n");
+ $self->ve_command("dpkg --force-confold --skip-same-version --configure -a");
if (-d "$rootdir/etc/event.d") {
- unlink <$rootdir/etc/event.d/tty*>;
+ unlink <$rootdir/etc/event.d/tty*>;
}
if (-f "$rootdir/etc/inittab") {
- $self->run_command ("sed -i -e '/getty\\s38400\\stty[23456]/d' '$rootdir/etc/inittab'");
+ $self->run_command("sed -i -e '/getty\\s38400\\stty[23456]/d' '$rootdir/etc/inittab'");
}
# Link /etc/mtab to /proc/mounts, so df and friends will work:
unlink "$rootdir/etc/mtab";
- $self->ve_command ("ln -s /proc/mounts /etc/mtab");
+ $self->ve_command("ln -s /proc/mounts /etc/mtab");
# reset password
- $self->ve_command ("usermod -L root");
+ $self->ve_command("usermod -L root");
if ($mta eq 'postfix') {
- $data = "postfix postfix/main_mailer_type select No configuration\n";
- $self->ve_debconfig_set ($data);
+ $data = "postfix postfix/main_mailer_type select No configuration\n";
+ $self->ve_debconfig_set($data);
- unlink "$rootdir/etc/mailname";
- write_file ($postfix_main_cf, "$rootdir/etc/postfix/main.cf");
+ unlink "$rootdir/etc/mailname";
+ write_file($postfix_main_cf, "$rootdir/etc/postfix/main.cf");
}
if (!$opts->{minimal}) {
- # unpack standard packages
- foreach my $p (@$standard) {
- $self->ve_dpkg ('unpack', $p);
- }
+ # unpack standard packages
+ foreach my $p (@$standard) {
+ $self->ve_dpkg('unpack', $p);
+ }
- $self->logmsg ("configure standard packages\n");
- $self->ve_command ("dpkg --force-confold --skip-same-version --configure -a");
+ $self->logmsg("configure standard packages\n");
+ $self->ve_command("dpkg --force-confold --skip-same-version --configure -a");
}
# disable HWCLOCK access
- $self->run_command ("echo 'HWCLOCKACCESS=no' >> '$rootdir/etc/default/rcS'");
+ $self->run_command("echo 'HWCLOCKACCESS=no' >> '$rootdir/etc/default/rcS'");
# disable hald
- $self->ve_divert_add ("/usr/sbin/hald");
+ $self->ve_divert_add("/usr/sbin/hald");
# disable /dev/urandom init
- $self->run_command ("install -m 0755 '$script_init_urandom' '$rootdir/etc/init.d/urandom'");
+ $self->run_command("install -m 0755 '$script_init_urandom' '$rootdir/etc/init.d/urandom'");
if ($suite eq 'etch' || $suite eq 'hardy' || $suite eq 'intrepid' || $suite eq 'jaunty') {
- # avoid klogd start
- $self->ve_divert_add ("/sbin/klogd");
+ # avoid klogd start
+ $self->ve_divert_add("/sbin/klogd");
}
my $cmd = 'find';
@@ -1643,21 +1669,23 @@ EOD
$cmd .= ' -e \'s/^\(fs\.inotify\.max_user_watches.*\)/#\1/\'';
$cmd .= ' -e \'s/^\(vm\.mmap_min_addr.*\)/#\1/\'';
$cmd .= " -i";
- $self->run_command ($cmd);
+ $self->run_command($cmd);
my $bindv6only = "$rootdir/etc/sysctl.d/bindv6only.conf";
if (-f $bindv6only) {
- $cmd = 'sed';
- $cmd .= ' -e \'s/^\(net\.ipv6\.bindv6only.*\)/#\1/\'';
- $cmd .= " -i '$bindv6only'";
- $self->run_command ($cmd);
+ $cmd = 'sed';
+ $cmd .= ' -e \'s/^\(net\.ipv6\.bindv6only.*\)/#\1/\'';
+ $cmd .= " -i '$bindv6only'";
+ $self->run_command($cmd);
}
if ($suiteinfo->{systemd}) {
- for my $unit (qw(sys-kernel-config.mount sys-kernel-debug.mount systemd-journald-audit.socket)) {
- $self->logmsg("Masking problematic systemd unit '$unit'\n");
- $self->mask_systemd_unit($unit);
- }
+ for my $unit (
+ qw(sys-kernel-config.mount sys-kernel-debug.mount systemd-journald-audit.socket)
+ ) {
+ $self->logmsg("Masking problematic systemd unit '$unit'\n");
+ $self->mask_systemd_unit($unit);
+ }
}
}
@@ -1670,15 +1698,15 @@ sub enter {
my $vestat = $self->ve_status();
if (!$vestat->{exist}) {
- $self->logmsg ("Please create the appliance first (bootstrap)");
- return;
+ $self->logmsg("Please create the appliance first (bootstrap)");
+ return;
}
if (!$vestat->{running}) {
- $self->run_command ("lxc-start -n $veid -f $conffile");
+ $self->run_command("lxc-start -n $veid -f $conffile");
}
- system ("lxc-attach -n $veid --rcfile $conffile --clear-env");
+ system("lxc-attach -n $veid --rcfile $conffile --clear-env");
}
sub ve_mysql_command {
@@ -1693,7 +1721,8 @@ sub ve_mysql_command {
sub ve_mysql_bootstrap {
my ($self, $sql, $password) = @_;
- my $cmd = "/usr/sbin/mysqld --bootstrap --user=mysql --skip-grant-tables --skip-bdb --skip-innodb --skip-ndbcluster";
+ my $cmd =
+ "/usr/sbin/mysqld --bootstrap --user=mysql --skip-grant-tables --skip-bdb --skip-innodb --skip-ndbcluster";
$self->ve_command($cmd, $sql);
}
@@ -1701,12 +1730,12 @@ sub compute_required {
my ($self, $pkglist) = @_;
my $pkginfo = $self->pkginfo();
- my $instpkgs = $self->read_installed ();
+ my $instpkgs = $self->read_installed();
my $closure = {};
__record_provides($pkginfo, $closure, [keys $instpkgs->%*]);
- return $self->closure ($closure, $pkglist);
+ return $self->closure($closure, $pkglist);
}
sub task_postgres {
@@ -1718,32 +1747,32 @@ sub task_postgres {
my $suite = $self->{config}->{suite};
if ($suite eq 'buster') {
- @supp = ('11');
- $pgversion = '11';
+ @supp = ('11');
+ $pgversion = '11';
} elsif ($suite eq 'bullseye') {
- @supp = ('13');
+ @supp = ('13');
} elsif ($suite eq 'bookworm') {
- @supp = ('15');
+ @supp = ('15');
} elsif ($suite eq 'trixie') {
- @supp = ('16', '17');
+ @supp = ('16', '17');
}
$pgversion = $opts->{version} if $opts->{version};
my $required;
if (defined($pgversion)) {
- die "unsupported postgres version '$pgversion'\n" if !grep { $pgversion eq $_; } @supp;
+ die "unsupported postgres version '$pgversion'\n" if !grep { $pgversion eq $_; } @supp;
- $required = $self->compute_required (["postgresql-$pgversion"]);
+ $required = $self->compute_required(["postgresql-$pgversion"]);
} else {
- $required = $self->compute_required (["postgresql"]);
+ $required = $self->compute_required(["postgresql"]);
}
- $self->cache_packages ($required);
-
- $self->ve_dpkg ('install', @$required);
+ $self->cache_packages($required);
+
+ $self->ve_dpkg('install', @$required);
my $iscript = "postgresql-$pgversion";
- $self->ve_command ("/etc/init.d/$iscript start") if $opts->{start};
+ $self->ve_command("/etc/init.d/$iscript start") if $opts->{start};
}
sub task_mysql {
@@ -1758,27 +1787,29 @@ sub task_mysql {
$self->cache_packages($required);
- $self->ve_dpkg ('install', @$required);
+ $self->ve_dpkg('install', @$required);
# fix security (see /usr/bin/mysql_secure_installation)
- my $sql = "DELETE FROM mysql.user WHERE User='';\n" .
- "DELETE FROM mysql.user WHERE User='root' AND Host!='localhost';\n" .
- "FLUSH PRIVILEGES;\n";
- $self->ve_mysql_bootstrap ($sql);
+ my $sql =
+ "DELETE FROM mysql.user WHERE User='';\n"
+ . "DELETE FROM mysql.user WHERE User='root' AND Host!='localhost';\n"
+ . "FLUSH PRIVILEGES;\n";
+ $self->ve_mysql_bootstrap($sql);
if ($password) {
- my $rpw = $password eq 'random' ? 'admin' : $password;
+ my $rpw = $password eq 'random' ? 'admin' : $password;
- my $sql = "USE mysql;\n" .
- "UPDATE user SET password=PASSWORD(\"$rpw\") WHERE user='root';\n" .
- "FLUSH PRIVILEGES;\n";
- $self->ve_mysql_bootstrap ($sql);
+ my $sql =
+ "USE mysql;\n"
+ . "UPDATE user SET password=PASSWORD(\"$rpw\") WHERE user='root';\n"
+ . "FLUSH PRIVILEGES;\n";
+ $self->ve_mysql_bootstrap($sql);
- write_file ("[client]\nuser=root\npassword=\"$rpw\"\n", "$rootdir/root/.my.cnf", 0600);
- if ($password eq 'random') {
- $self->install_init_script ($script_mysql_randompw, 2, 20);
- }
+ write_file("[client]\nuser=root\npassword=\"$rpw\"\n", "$rootdir/root/.my.cnf", 0600);
+ if ($password eq 'random') {
+ $self->install_init_script($script_mysql_randompw, 2, 20);
+ }
}
$self->ve_command("/etc/init.d/mysql start") if $opts->{start}; # FIXME: use systemd service?!
@@ -1794,33 +1825,34 @@ sub task_php {
my $base_set = [qw(php-cli libapache2-mod-php php-gd)];
my $required = $self->compute_required($base_set);
- $self->cache_packages ($required);
+ $self->cache_packages($required);
- $self->ve_dpkg ('install', @$required);
+ $self->ve_dpkg('install', @$required);
if ($memlimit) {
- my $sed_cmd = ['sed', '-e', "s/^\\s*memory_limit\\s*=.*;/memory_limit = ${memlimit}M;/", '-i'];
- my $found = 0;
- for my $fn (glob("'${rootdir}/etc/php/*/apache2/php.ini'")) {
- push @$sed_cmd, "$rootdir/$fn";
- $found = 1;
- }
- if (!$found) {
- warn "WARN: did not found any php.ini to set the memlimit!\n";
- return;
- }
- $self->run_command($sed_cmd);
+ my $sed_cmd =
+ ['sed', '-e', "s/^\\s*memory_limit\\s*=.*;/memory_limit = ${memlimit}M;/", '-i'];
+ my $found = 0;
+ for my $fn (glob("'${rootdir}/etc/php/*/apache2/php.ini'")) {
+ push @$sed_cmd, "$rootdir/$fn";
+ $found = 1;
+ }
+ if (!$found) {
+ warn "WARN: did not found any php.ini to set the memlimit!\n";
+ return;
+ }
+ $self->run_command($sed_cmd);
}
}
sub install {
my ($self, $pkglist, $unpack) = @_;
- my $required = $self->compute_required ($pkglist);
+ my $required = $self->compute_required($pkglist);
- $self->cache_packages ($required);
+ $self->cache_packages($required);
- $self->ve_dpkg ($unpack ? 'unpack' : 'install', @$required);
+ $self->ve_dpkg($unpack ? 'unpack' : 'install', @$required);
}
sub cleanup {
@@ -1830,7 +1862,7 @@ sub cleanup {
unlink "$self->{targetname}.tar";
unlink "$self->{targetname}.tar.gz";
- $self->ve_destroy ();
+ $self->ve_destroy();
unlink ".veid";
rmtree $self->{cachedir} if $distclean && !$self->{config}->{cachedir};
diff --git a/dab b/dab
index 9a010c0..11a4cba 100755
--- a/dab
+++ b/dab
@@ -32,11 +32,11 @@ sub print_usage {
print STDERR "USAGE: dab <command> [parameters]\n\n";
for my $cmd (sort keys %$commands) {
- if (my $opts = $commands->{$cmd}) {
- print STDERR " dab $cmd $opts\n";
- } else {
- print STDERR " dab $cmd\n";
- }
+ if (my $opts = $commands->{$cmd}) {
+ print STDERR " dab $cmd $opts\n";
+ } else {
+ print STDERR " dab $cmd\n";
+ }
}
}
@@ -46,14 +46,14 @@ sub fatal_usage {
print STDERR "\nERROR: $msg\n\n" if $msg;
print_usage();
- exit (-1);
+ exit(-1);
}
-if (scalar (@ARGV) == 0) {
+if (scalar(@ARGV) == 0) {
fatal_usage("no command specified");
}
-my $cmdline = join (' ', @ARGV);
+my $cmdline = join(' ', @ARGV);
my $cmd = shift @ARGV;
if (!$cmd) {
@@ -62,16 +62,17 @@ if (!$cmd) {
fatal_usage("unknown command '$cmd'");
} elsif ($cmd eq 'help') {
print_usage();
- exit (0);
+ exit(0);
}
my $dab;
-sub dab :prototype() { # make it a directly as `dab->foo()` callable singleton
+
+sub dab : prototype() { # make it a directly as `dab->foo()` callable singleton
$dab = PVE::DAB->new() if !$dab;
return $dab;
}
-dab->writelog ("dab: $cmdline\n");
+dab->writelog("dab: $cmdline\n");
$SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
die "interrupted by signal\n";
@@ -79,153 +80,161 @@ $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
eval {
if ($cmd eq 'init') {
- die "command '$cmd' expects no arguments.\n" if scalar (@ARGV) != 0;
+ die "command '$cmd' expects no arguments.\n" if scalar(@ARGV) != 0;
- dab->initialize();
+ dab->initialize();
} elsif ($cmd eq 'bootstrap') {
- my $opts = {};
- if (!GetOptions ($opts, 'exim', 'minimal', 'device-skelleton', 'include=s',
- 'exclude=s', 'no-ssh', 'mta=s')) {
- fatal_usage();
- }
- die "command 'bootstrap' expects no arguments.\n" if scalar (@ARGV) != 0;
-
- $dab->ve_init();
- $dab->bootstrap ($opts);
+ my $opts = {};
+ if (!GetOptions(
+ $opts,
+ 'exim',
+ 'minimal',
+ 'device-skelleton',
+ 'include=s',
+ 'exclude=s',
+ 'no-ssh',
+ 'mta=s',
+ )) {
+ fatal_usage();
+ }
+ die "command 'bootstrap' expects no arguments.\n" if scalar(@ARGV) != 0;
+
+ $dab->ve_init();
+ $dab->bootstrap($opts);
} elsif ($cmd eq 'finalize') {
- my $opts = {};
- if (!GetOptions ($opts, 'keepmycnf', 'compressor=s')) {
- fatal_usage();
- }
- die "command '$cmd' expects no arguments.\n" if scalar (@ARGV) != 0;
+ my $opts = {};
+ if (!GetOptions($opts, 'keepmycnf', 'compressor=s')) {
+ fatal_usage();
+ }
+ die "command '$cmd' expects no arguments.\n" if scalar(@ARGV) != 0;
- $dab->finalize($opts);
+ $dab->finalize($opts);
} elsif ($cmd eq 'veid') {
- die "command '$cmd' expects no arguments.\n" if scalar (@ARGV) != 0;
+ die "command '$cmd' expects no arguments.\n" if scalar(@ARGV) != 0;
- print $dab->{veid} . "\n";
+ print $dab->{veid} . "\n";
} elsif ($cmd eq 'basedir') {
- die "command '$cmd' expects no arguments.\n" if scalar (@ARGV) != 0;
+ die "command '$cmd' expects no arguments.\n" if scalar(@ARGV) != 0;
- print $dab->{rootfs} . "\n";
+ print $dab->{rootfs} . "\n";
} elsif ($cmd eq 'targetname') {
- die "command '$cmd' expects no arguments.\n" if scalar (@ARGV) != 0;
- print $dab->{targetname} . "\n";
+ die "command '$cmd' expects no arguments.\n" if scalar(@ARGV) != 0;
+ print $dab->{targetname} . "\n";
} elsif ($cmd eq 'packagefile') {
- die "command '$cmd' expects no arguments.\n" if scalar (@ARGV) != 0;
- # FIXME: either drop this or make it compressor aware, not all end with .gz...
- print "$dab->{targetname}.tar.gz\n";
+ die "command '$cmd' expects no arguments.\n" if scalar(@ARGV) != 0;
+ # FIXME: either drop this or make it compressor aware, not all end with .gz...
+ print "$dab->{targetname}.tar.gz\n";
} elsif ($cmd eq 'list') {
- my $verbose;
- if (!GetOptions ('verbose' =>\$verbose)) {
- fatal_usage();
- }
- die "command '$cmd' expects no arguments.\n" if scalar (@ARGV) != 0;
-
- my $instpkgs = $dab->read_installed ();
-
- foreach my $pkg (sort keys %$instpkgs) {
- if ($verbose) {
- my $version = $instpkgs->{$pkg}->{version};
- print "$pkg $version\n";
- } else {
- print "$pkg\n";
- }
- }
+ my $verbose;
+ if (!GetOptions('verbose' => \$verbose)) {
+ fatal_usage();
+ }
+ die "command '$cmd' expects no arguments.\n" if scalar(@ARGV) != 0;
+
+ my $instpkgs = $dab->read_installed();
+
+ foreach my $pkg (sort keys %$instpkgs) {
+ if ($verbose) {
+ my $version = $instpkgs->{$pkg}->{version};
+ print "$pkg $version\n";
+ } else {
+ print "$pkg\n";
+ }
+ }
} elsif ($cmd eq 'task') {
- my $task = shift @ARGV;
- if (!$task) {
- fatal_usage("no task specified");
- }
+ my $task = shift @ARGV;
+ if (!$task) {
+ fatal_usage("no task specified");
+ }
- my $opts = {};
- if ($task eq 'mysql') {
- if (!GetOptions ($opts, 'password=s', 'start')) {
- fatal_usage();
- }
- die "task '$task' expects no arguments.\n" if scalar (@ARGV) != 0;
+ my $opts = {};
+ if ($task eq 'mysql') {
+ if (!GetOptions($opts, 'password=s', 'start')) {
+ fatal_usage();
+ }
+ die "task '$task' expects no arguments.\n" if scalar(@ARGV) != 0;
- $dab->task_mysql ($opts);
+ $dab->task_mysql($opts);
- } elsif ($task eq 'postgres') {
- if (!GetOptions ($opts, 'version=s', 'start')) {
- fatal_usage();
- }
- die "task '$task' expects no arguments.\n" if scalar (@ARGV) != 0;
+ } elsif ($task eq 'postgres') {
+ if (!GetOptions($opts, 'version=s', 'start')) {
+ fatal_usage();
+ }
+ die "task '$task' expects no arguments.\n" if scalar(@ARGV) != 0;
- $dab->task_postgres ($opts);
+ $dab->task_postgres($opts);
- } elsif ($task eq 'php') {
- if (!GetOptions ($opts, 'memlimit=i')) {
- fatal_usage();
- }
- die "task '$task' expects no arguments.\n" if scalar (@ARGV) != 0;
+ } elsif ($task eq 'php') {
+ if (!GetOptions($opts, 'memlimit=i')) {
+ fatal_usage();
+ }
+ die "task '$task' expects no arguments.\n" if scalar(@ARGV) != 0;
- $dab->task_php ($opts);
+ $dab->task_php($opts);
- } else {
- fatal_usage("unknown task '$task'");
- }
+ } else {
+ fatal_usage("unknown task '$task'");
+ }
} elsif ($cmd eq 'install' || $cmd eq 'unpack') {
- my $required;
- foreach my $arg (@ARGV) {
- if ($arg =~ m/\.pkglist$/) {
- open (TMP, $arg) ||
- die "cant open package list '$arg' - $!";
- while (defined (my $line = <TMP>)) {
- chomp $line;
- next if $line =~ m/^\s*$/;
- next if $line =~ m/\#/;
- if ($line =~ m/^\s*(\S+)\s*$/) {
- push @$required, $1;
- } else {
- die "invalid package name in '$arg' - $line\n";
- }
- }
- } else {
- push @$required, $arg;
- }
-
- close (TMP);
- }
-
- $dab->install ($required, $cmd eq 'unpack');
+ my $required;
+ foreach my $arg (@ARGV) {
+ if ($arg =~ m/\.pkglist$/) {
+ open(TMP, $arg)
+ || die "cant open package list '$arg' - $!";
+ while (defined(my $line = <TMP>)) {
+ chomp $line;
+ next if $line =~ m/^\s*$/;
+ next if $line =~ m/\#/;
+ if ($line =~ m/^\s*(\S+)\s*$/) {
+ push @$required, $1;
+ } else {
+ die "invalid package name in '$arg' - $line\n";
+ }
+ }
+ } else {
+ push @$required, $arg;
+ }
+
+ close(TMP);
+ }
+
+ $dab->install($required, $cmd eq 'unpack');
} elsif ($cmd eq 'exec') {
- $dab->ve_exec (@ARGV);
+ $dab->ve_exec(@ARGV);
} elsif ($cmd eq 'enter') {
- die "command '$cmd' expects no arguments.\n" if scalar (@ARGV) != 0;
+ die "command '$cmd' expects no arguments.\n" if scalar(@ARGV) != 0;
- $dab->enter();
+ $dab->enter();
} elsif ($cmd eq 'clean') {
- die "command '$cmd' expects no arguments.\n" if scalar (@ARGV) != 0;
+ die "command '$cmd' expects no arguments.\n" if scalar(@ARGV) != 0;
- $dab->cleanup(0);
+ $dab->cleanup(0);
} elsif ($cmd eq 'dist-clean') {
- die "command '$cmd' expects no arguments.\n" if scalar (@ARGV) != 0;
+ die "command '$cmd' expects no arguments.\n" if scalar(@ARGV) != 0;
- $dab->cleanup(1);
+ $dab->cleanup(1);
} else {
- fatal_usage("invalid command '$cmd'");
+ fatal_usage("invalid command '$cmd'");
}
};
if (my $err = $@) {
- $dab->logmsg ($@);
- die ($@);
+ $dab->logmsg($@);
+ die($@);
}
exit 0;
@@ -493,7 +502,7 @@ characters long and must start with an alphanumeric character.
Target architecture.
-=item B<Version:> I<upstream_version[-build_revision]>
+=item B<Version:> I<upstream_version[-build_revision]>
The version number of an appliance.
--
2.52.0
_______________________________________________
pve-devel mailing list
pve-devel@lists.proxmox.com
https://lists.proxmox.com/cgi-bin/mailman/listinfo/pve-devel
next prev parent reply other threads:[~2025-11-21 15:45 UTC|newest]
Thread overview: 8+ messages / expand[flat|nested] mbox.gz Atom feed top
2025-11-18 22:01 [pve-devel] [PATCH dab 0/7] Improvements to DAB; Support Devuan 6.0 Luke Harding
2025-11-18 22:01 ` [pve-devel] [PATCH dab 1/7] Add a '--no-ssh' option to dab bootstrap to disable ssh packages that are automatically included Luke Harding
2025-11-18 22:01 ` [pve-devel] [PATCH dab 2/7] Add origin for devuan suites Luke Harding
2025-11-18 22:01 ` [pve-devel] [PATCH dab 3/7] Add devuan "Excalibur" 6.0 suite Luke Harding
2025-11-18 22:01 ` [pve-devel] [PATCH dab 4/7] Change closure algorithm to use an alternate package if the most preferred candidate fails Luke Harding
2025-11-18 22:01 ` [pve-devel] [PATCH dab 5/7] Add new `[--mta <postfix|exim|none>]` flag; Deprecate --exim Luke Harding
2025-11-18 22:01 ` Luke Harding [this message]
2025-11-18 22:01 ` [pve-devel] [PATCH dab 7/7] Bump version to 3.8.0 Luke Harding
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20251118220122.61257-7-luke@lukeh990.io \
--to=luke@lukeh990.io \
--cc=pve-devel@lists.proxmox.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox