mirror of
https://github.com/speed47/btrfs-list
synced 2024-06-26 05:02:49 +00:00
1208 lines
45 KiB
Perl
Executable File
1208 lines
45 KiB
Perl
Executable File
#! /usr/bin/perl
|
|
# vim: et:ts=4:sw=4:sts=4:
|
|
#
|
|
# SPDX-License-Identifier: GPL-2.0-only
|
|
#
|
|
# btrfs-list: a wrapper to btrfs-progs to show a nice tree-style overview
|
|
# of your btrfs subvolumes and snapshots, a la 'zfs list'
|
|
#
|
|
# Check for the latest version at:
|
|
# https://github.com/speed47/btrfs-list
|
|
# git clone https://github.com/speed47/btrfs-list.git
|
|
# or wget https://raw.githubusercontent.com/speed47/btrfs-list/master/btrfs-list -O btrfs-list
|
|
# or curl -L https://raw.githubusercontent.com/speed47/btrfs-list/master/btrfs-list -o btrfs-list
|
|
#
|
|
# perltidy -b -csc -iscl -nolc -nbbc -pt=2 -sbt=2 -bt=2 -l=120 -msc=1 btrfs-list
|
|
#
|
|
# Stephane Lesimple
|
|
#
|
|
use strict;
|
|
use warnings;
|
|
use version;
|
|
use File::Basename;
|
|
use IPC::Open3;
|
|
use Symbol 'gensym';
|
|
use Getopt::Long qw{ :config gnu_getopt no_ignore_case };
|
|
use Data::Dumper;
|
|
use Term::ANSIColor;
|
|
|
|
my $VERSION = "2.3";
|
|
|
|
$Data::Dumper::Sortkeys = 1;
|
|
$Data::Dumper::Terse = 1;
|
|
use constant KiB => 1024**1;
|
|
use constant MiB => 1024**2;
|
|
use constant GiB => 1024**3;
|
|
use constant TiB => 1024**4;
|
|
use constant PiB => 1024**5;
|
|
|
|
use constant PARENT_UUID_DF => '*';
|
|
use constant PARENT_UUID_NONE_MAINVOL => '+';
|
|
use constant PARENT_UUID_NONE => '-';
|
|
|
|
use constant FAKE_ID_DF => -1;
|
|
use constant FAKE_ID_GHOST => -2;
|
|
|
|
sub help {
|
|
print <<"EOF";
|
|
Usage: $0 [options] [mountpoint1 [mountpoint2 [...]]]
|
|
|
|
If no mountpoints are specified, display info for all btrfs filesystems.
|
|
|
|
-h, --help display this message
|
|
--debug enable debug output
|
|
-q, --quiet silence quota disabled & quota rescan warnings,
|
|
repeat to silence all other warnings.
|
|
--version display version info
|
|
--color WHEN colorize the output; WHEN can be 'never',
|
|
'always', or 'auto' (default is:
|
|
colorize if STDOUT is a term)
|
|
-n, --no-color synonym of --color=never
|
|
--bright use bright colors (better for dark terminals)
|
|
-H, --no-header hide header from output
|
|
-r, --raw show raw numbers instead of human-readable
|
|
--btrfs-binary BIN path to the btrfs binary to use instead of using
|
|
the first binary found in the PATH
|
|
--ignore-version-check try to continue even if btrfs-progs seems too old
|
|
--ignore-root-check try to continue even if we are not root
|
|
|
|
-s, --hide-snap hide all snapshots
|
|
-S, --snap-only only show snapshots
|
|
-d, --deleted show deleted parents of orphaned snapshots
|
|
--snap-min-excl SIZE hide snapshots whose exclusively allocated extents
|
|
take up less space than SIZE
|
|
--snap-max-excl SIZE hide snapshots whose exclusively allocated extents
|
|
take up more space than SIZE
|
|
-f, --free-space only show free space on the filesystem
|
|
-u, --used display used space instead of free space
|
|
|
|
-p, --profile PROFILE override data profile detection and consider it
|
|
as 'dup', 'single', 'raid0', 'raid1',
|
|
'raid1c3', 'raid1c4', 'raid10', 'raid5' or
|
|
'raid6' for free space calculation
|
|
|
|
-a, --show-all show all information for each item
|
|
--show-gen show generation of each item
|
|
--show-cgen show generation at creation of each item
|
|
--show-id show id of each item
|
|
--show-parent show parent id of each item
|
|
--show-toplevel show top level of each item
|
|
--show-uuid show uuid of each item
|
|
--show-puuid show parent uuid of each item
|
|
--show-ruuid show received uuid of each item
|
|
--show-otime show snap creation time
|
|
|
|
-w, --wide don't truncate uuids on output (this is the
|
|
default if STDOUT is NOT a term)
|
|
--no-wide always truncate uuids on output (useful to
|
|
override above default)
|
|
--max-name-len LEN trim long subvol names to LEN. 0 means never trim.
|
|
Defaults to 80 if STDOUT is a term, 0 otherwise.
|
|
--indent LEN number of spaces to indent the tree, default: 3.
|
|
|
|
SIZE can be a number (in bytes), or a number followed by k, M, G, T or P.
|
|
|
|
EOF
|
|
exit 0;
|
|
} ## end sub help
|
|
|
|
GetOptions(
|
|
'debug' => \my $opt_debug,
|
|
'version' => \my $opt_version,
|
|
'ignore-version-check' => \my $opt_ignore_version_check,
|
|
'ignore-root-check' => \my $opt_ignore_root_check,
|
|
'q|quiet+' => \my $opt_quiet,
|
|
's|hide-snap' => \my $opt_hide_snapshots,
|
|
'S|snap-only' => \my $opt_only_snapshots,
|
|
'f|free-space' => \my $opt_free_space,
|
|
'a|show-all' => \my $opt_show_all,
|
|
'H|no-header' => \my $opt_no_header,
|
|
'show-gen' => \my $opt_show_gen,
|
|
'show-cgen' => \my $opt_show_cgen,
|
|
'show-id' => \my $opt_show_id,
|
|
'show-parent' => \my $opt_show_parent,
|
|
'show-toplevel' => \my $opt_show_toplevel,
|
|
'show-uuid' => \my $opt_show_uuid,
|
|
'show-puuid' => \my $opt_show_puuid,
|
|
'show-ruuid' => \my $opt_show_ruuid,
|
|
'show-otime' => \my $opt_show_otime,
|
|
'wide|w' => \my $opt_wide,
|
|
'no-wide' => \my $opt_no_wide,
|
|
'max-name-len=i' => \my $opt_max_name_len,
|
|
'indent=i' => \my $opt_indent,
|
|
'snap-min-used|snap-min-excl=s' => \my $opt_snap_min_used,
|
|
'snap-max-used|snap-max-excl=s' => \my $opt_snap_max_used,
|
|
'n|no-color' => \my $opt_no_color,
|
|
'color=s' => \my $opt_color,
|
|
'bright' => \my $opt_bright,
|
|
'h|help|usage' => \my $opt_help,
|
|
'p|profile=s' => \my $opt_profile,
|
|
'r|raw' => \my $opt_raw,
|
|
'btrfs-binary=s' => \my $opt_btrfs_binary,
|
|
'd|deleted' => \my $opt_deleted,
|
|
'u|used' => \my $opt_used,
|
|
) or die "FATAL: Error parsing arguments, aborting\n";
|
|
|
|
$opt_quiet ||= 0;
|
|
|
|
sub debug {
|
|
return if !$opt_debug;
|
|
print STDERR $_ . "\n" for @_;
|
|
return;
|
|
}
|
|
|
|
sub warning {
|
|
my ($level, @lines) = @_;
|
|
return if ($level <= $opt_quiet);
|
|
print STDERR "WARNING: $_\n" for @lines;
|
|
return;
|
|
} ## end sub warning
|
|
|
|
sub run_cmd {
|
|
my %params = @_;
|
|
my $cmd = $params{'cmd'};
|
|
my $silent_stderr = $params{'silent_stderr'};
|
|
my $fatal = $params{'fatal'};
|
|
|
|
if ($cmd->[0] eq 'btrfs' && $opt_btrfs_binary) {
|
|
$cmd->[0] = $opt_btrfs_binary;
|
|
}
|
|
|
|
my ($_stdin, $_stdout, $_stderr);
|
|
$_stderr = gensym;
|
|
debug("about to run_cmd ['" . join("','", @$cmd) . "']");
|
|
my $pid = open3($_stdin, $_stdout, $_stderr, @$cmd);
|
|
debug("waiting for cmd to complete...");
|
|
my @stdout = ();
|
|
my @stderr = ();
|
|
while (<$_stdout>) {
|
|
chomp;
|
|
debug("stdout: " . $_);
|
|
/WARNING: (.+)/ and warning(2, "btrfs-progs: $1");
|
|
push @stdout, $_;
|
|
} ## end while (<$_stdout>)
|
|
while (<$_stderr>) {
|
|
chomp;
|
|
debug("stderr: " . $_);
|
|
/WARNING: (RAID56 detected, not implemented)/ and warning(2, "btrfs-progs: $1");
|
|
if (!$silent_stderr) {
|
|
print join(' ', @$cmd) . ": stderr: " . $_ . "\n";
|
|
}
|
|
push @stderr, $_;
|
|
} ## end while (<$_stderr>)
|
|
waitpid($pid, 0);
|
|
my $child_exit_status = $? >> 8;
|
|
debug("cmd return status is $child_exit_status");
|
|
if ($fatal && $child_exit_status != 0) {
|
|
print STDERR "FATAL: the command [" . join(' ', @$cmd) . "] returned a non-zero status ($child_exit_status)\n";
|
|
print STDERR "FATAL: stdout: " . $_ . "\n" for @stdout;
|
|
print STDERR "FATAL: stderr: " . $_ . "\n" for @stderr;
|
|
exit 1;
|
|
} ## end if ($fatal && $child_exit_status...)
|
|
return {status => $child_exit_status, stdout => \@stdout, stderr => \@stderr};
|
|
} ## end sub run_cmd
|
|
|
|
sub link2real {
|
|
my $dev = shift;
|
|
CORE::state %readlinkcache;
|
|
if (defined $readlinkcache{$dev}) {
|
|
return $readlinkcache{$dev};
|
|
}
|
|
my $cmd = run_cmd(fatal => 1, cmd => [qw{ readlink -f }, $dev]);
|
|
if (defined $cmd->{stdout}->[0]) {
|
|
$readlinkcache{$dev} = $cmd->{stdout}->[0];
|
|
return $readlinkcache{$dev};
|
|
}
|
|
return $dev;
|
|
} ## end sub link2real
|
|
|
|
# returns a list with 5 items
|
|
# item1: color-code before the number
|
|
# item2: the string
|
|
# item3: color-code after the number and before the multiplier
|
|
# item4: the multiplier (1 char)
|
|
# item5: color-code after the multiplier
|
|
sub pretty_print {
|
|
my ($raw, $mode) = @_;
|
|
|
|
=comment
|
|
debug("pretty_print(@_);");
|
|
my @c = caller(0);
|
|
debug(Dumper(\@c));
|
|
=cut
|
|
|
|
if ($opt_raw) {
|
|
return ('', $raw, '', '', '') if (!$mode || $raw ne 0);
|
|
return ('', '-', '', '', '');
|
|
}
|
|
elsif ($mode && ($raw eq '-' || $raw == 0)) {
|
|
return ('', '-', '', '', '') if $mode == 1;
|
|
return ('', '0', '', '', '') if $mode == 2;
|
|
}
|
|
|
|
my $bright = ($opt_bright ? 'bright_' : '');
|
|
CORE::state($nbcolors, $dark);
|
|
if (!defined $nbcolors) {
|
|
my $cmd = run_cmd(cmd => [qw{ tput colors }], silent_stderr => 1);
|
|
$nbcolors = $cmd->{stdout}->[0];
|
|
chomp $nbcolors;
|
|
$nbcolors = 8 if !$nbcolors;
|
|
debug("nbcolors=$nbcolors");
|
|
$dark = ($nbcolors <= 8 ? "${bright}black" : 'grey9');
|
|
|
|
# terms that don't support colors (except if --color=always)
|
|
$ENV{'ANSI_COLORS_DISABLED'} = 1 if ($nbcolors == -1 && $opt_color ne 'always');
|
|
} ## end if (!defined $nbcolors)
|
|
my $r = color('reset');
|
|
if ($raw > PiB) { return (color("${bright}magenta"), sprintf('%.2f', $raw / PiB), color($dark), 'P', $r); }
|
|
elsif ($raw > TiB) { return (color("${bright}red"), sprintf('%.2f', $raw / TiB), color($dark), 'T', $r); }
|
|
elsif ($raw > GiB) { return (color("${bright}yellow"), sprintf('%.2f', $raw / GiB), color($dark), 'G', $r); }
|
|
elsif ($raw > MiB) { return (color("${bright}green"), sprintf('%.2f', $raw / MiB), color($dark), 'M', $r); }
|
|
elsif ($raw > KiB) { return (color("${bright}blue"), sprintf('%.2f', $raw / KiB), color($dark), 'k', $r); }
|
|
else { return ('', sprintf('%.2f', $raw), '', ' ', ''); }
|
|
} ## end sub pretty_print
|
|
|
|
sub pretty_print_str {
|
|
return sprintf("%s%s%s%s%s", pretty_print(@_));
|
|
}
|
|
|
|
sub human2raw {
|
|
my $human = shift;
|
|
return $human if ($human !~ /^((\d+)(\.\d+)?)([kMGTP])/);
|
|
if ($4 eq 'P') { return $1 * PiB; }
|
|
elsif ($4 eq 'T') { return $1 * TiB; }
|
|
elsif ($4 eq 'G') { return $1 * GiB; }
|
|
elsif ($4 eq 'M') { return $1 * MiB; }
|
|
elsif ($4 eq 'k') { return $1 * KiB; }
|
|
return $human;
|
|
} ## end sub human2raw
|
|
|
|
sub compute_allocatable_for_profile {
|
|
my ($profile, $free, $devBytesRef) = @_;
|
|
my $unallocFree = 0;
|
|
my $sliceSize = TiB;
|
|
my %devBytes = %$devBytesRef;
|
|
while (1) {
|
|
|
|
# reduce sliceSize if needed, note that btrfs never allocates chunks
|
|
# smaller than 1 MiB
|
|
if ($sliceSize > MiB && grep { $_ < 3 * $sliceSize } values %devBytes) {
|
|
$sliceSize /= 2;
|
|
next;
|
|
}
|
|
|
|
# sort device by remaining free space.
|
|
# $sk[0] has the most available space, then $sk[1], etc.
|
|
my @sk = sort { $devBytes{$b} <=> $devBytes{$a} } keys %devBytes;
|
|
|
|
if ($profile eq 'raid1') {
|
|
last if ($devBytes{$sk[1]} <= $sliceSize); # out of space
|
|
$unallocFree += $sliceSize;
|
|
$devBytes{$sk[0]} -= $sliceSize;
|
|
$devBytes{$sk[1]} -= $sliceSize;
|
|
} ## end if ($profile eq 'raid1')
|
|
elsif ($profile eq 'raid1c3') {
|
|
last if ($devBytes{$sk[2]} <= $sliceSize); # out of space
|
|
$unallocFree += $sliceSize;
|
|
$devBytes{$sk[0]} -= $sliceSize;
|
|
$devBytes{$sk[1]} -= $sliceSize;
|
|
$devBytes{$sk[2]} -= $sliceSize;
|
|
} ## end elsif ($profile eq 'raid1c3')
|
|
elsif ($profile eq 'raid1c4') {
|
|
last if ($devBytes{$sk[3]} <= $sliceSize); # out of space
|
|
$unallocFree += $sliceSize;
|
|
$devBytes{$sk[0]} -= $sliceSize;
|
|
$devBytes{$sk[1]} -= $sliceSize;
|
|
$devBytes{$sk[2]} -= $sliceSize;
|
|
$devBytes{$sk[3]} -= $sliceSize;
|
|
} ## end elsif ($profile eq 'raid1c4')
|
|
elsif ($profile eq 'raid10') {
|
|
last if ($devBytes{$sk[3]} <= $sliceSize); # out of space
|
|
$unallocFree += $sliceSize * 2;
|
|
$devBytes{$sk[0]} -= $sliceSize;
|
|
$devBytes{$sk[1]} -= $sliceSize;
|
|
$devBytes{$sk[2]} -= $sliceSize;
|
|
$devBytes{$sk[3]} -= $sliceSize;
|
|
} ## end elsif ($profile eq 'raid10')
|
|
elsif ($profile eq 'raid5' || $profile eq 'raid6') {
|
|
my $parity = ($profile eq 'raid5' ? 1 : 2);
|
|
my $nb = grep { $_ > $sliceSize } values %devBytes;
|
|
last if $nb < $parity + 1; # out of space
|
|
foreach my $dev (keys %devBytes) {
|
|
$devBytes{$dev} -= $sliceSize if $devBytes{$dev} > $sliceSize;
|
|
}
|
|
$unallocFree += ($nb - $parity) * $sliceSize;
|
|
} ## end elsif ($profile eq 'raid5'...)
|
|
elsif (grep { $profile eq $_ } qw( raid0 single dup )) {
|
|
|
|
# those are easy, we just add up every free space of every device
|
|
# and call it a day (no need to loop through the allocator)
|
|
$unallocFree += $_ for values %devBytes;
|
|
$unallocFree /= 2 if $profile eq 'dup';
|
|
%devBytes = ();
|
|
last;
|
|
} ## end elsif (grep { $profile eq...})
|
|
else {
|
|
print "ERROR: Unknown data profile '$profile'!\n";
|
|
exit 1;
|
|
}
|
|
} ## end while (1)
|
|
$free += $unallocFree;
|
|
|
|
# if free is < 1 MiB, then consider it as full to the brim,
|
|
# because when FS is completely full, it always shows a couple
|
|
# kB left (depending on the profile), even if not a single more
|
|
# byte can be written.
|
|
$free = 0 if $free < MiB;
|
|
|
|
# remaining space on each device is unallocatable, don't count space
|
|
# below the MiB for a given device for the same reason as above
|
|
my $unallocatable = 0;
|
|
foreach (values %devBytes) {
|
|
$unallocatable += ($_ - MiB) if $_ > MiB;
|
|
}
|
|
|
|
return {allocatable => $free, unallocatable => $unallocatable};
|
|
} ## end sub compute_allocatable_for_profile
|
|
|
|
# MAIN
|
|
|
|
if ($opt_version) {
|
|
|
|
# if we were git clone'd, adjust VERSION
|
|
my $ver = $VERSION;
|
|
my $dir = dirname($0);
|
|
if (-d "$dir/.git") {
|
|
my $cmd = run_cmd(silent_stderr => 1, cmd => [qw{ git -C }, $dir, qw{ describe --tags --dirty }]);
|
|
if ($cmd->{status} == 0 && $cmd->{stdout}) {
|
|
$ver = $cmd->{stdout}[0];
|
|
$ver =~ s/^v//;
|
|
}
|
|
} ## end if (-d "$dir/.git")
|
|
|
|
# also get btrfs --version
|
|
my $btrfsver;
|
|
my $cmd = run_cmd(cmd => [qw{ btrfs --version }]);
|
|
if ($cmd->{status} == 0) {
|
|
($btrfsver) = $cmd->{stdout}->[0] =~ /v([0-9.]+)/;
|
|
}
|
|
|
|
print "btrfs-list v$ver using btrfs v$btrfsver\n";
|
|
exit 0;
|
|
} ## end if ($opt_version)
|
|
|
|
# check opts
|
|
|
|
$opt_color = 'never' if $opt_no_color;
|
|
$opt_color //= 'auto';
|
|
|
|
if (defined $opt_snap_min_used) {
|
|
$opt_snap_min_used = human2raw($opt_snap_min_used);
|
|
}
|
|
if (defined $opt_snap_max_used) {
|
|
$opt_snap_max_used = human2raw($opt_snap_max_used);
|
|
}
|
|
|
|
if ($opt_color eq 'never' || ($opt_color eq 'auto' && !-t 1)) { ## no critic(InputOutput::ProhibitInteractiveTest)
|
|
$ENV{'ANSI_COLORS_DISABLED'} = 1;
|
|
}
|
|
if (!$opt_wide && !-t 1) { ## no critic(InputOutput::ProhibitInteractiveTest)
|
|
|
|
# wide if STDOUT is NOT a term
|
|
$opt_wide = 1;
|
|
}
|
|
if (defined $opt_no_wide) {
|
|
|
|
# --no-wide always wins
|
|
$opt_wide = 0;
|
|
}
|
|
|
|
if (!defined $opt_max_name_len) {
|
|
# if STDOUT is a term, set to 80, otherwise 0 (no limit)
|
|
$opt_max_name_len = (-t 1 ? 80 : 0); ## no critic(InputOutput::ProhibitInteractiveTest)
|
|
}
|
|
if ($opt_max_name_len > 0 && $opt_max_name_len < 4) {
|
|
$opt_max_name_len = 4;
|
|
}
|
|
|
|
$opt_indent //= 3;
|
|
|
|
if (defined $opt_profile && $opt_profile !~ /^(raid([0156]|1c[34]|10)|single|dup)$/) {
|
|
print STDERR "FATAL: invalid argument for --profile\n";
|
|
help();
|
|
exit 1;
|
|
}
|
|
|
|
if ($opt_show_all) {
|
|
$opt_show_gen = 1;
|
|
$opt_show_cgen = 1;
|
|
$opt_show_id = 1;
|
|
$opt_show_parent = 1;
|
|
$opt_show_toplevel = 1;
|
|
$opt_show_uuid = 1;
|
|
$opt_show_puuid = 1;
|
|
$opt_show_ruuid = 1;
|
|
$opt_show_otime = 1;
|
|
} ## end if ($opt_show_all)
|
|
|
|
if ($opt_btrfs_binary && !-f -x $opt_btrfs_binary) {
|
|
print STDERR "FATAL: Specified btrfs binary '$opt_btrfs_binary' doesn't exist or is not executable\n";
|
|
exit 1;
|
|
}
|
|
|
|
help() if $opt_help;
|
|
|
|
# check btrfs-progs version
|
|
|
|
my $cmd = run_cmd(fatal => 1, cmd => [qw{ btrfs --version }]);
|
|
my ($version_verbatim, $version) = $cmd->{stdout}->[0] =~ /v((\d+\.\d+)\S*)/;
|
|
|
|
if (version->declare($version)->numify lt version->declare("3.18")->numify && !$opt_ignore_version_check) {
|
|
print STDERR "FATAL: you're using an old version of btrfs-progs, v$version, "
|
|
. "we need at least version 3.18 (Dec 2014).\n";
|
|
print STDERR "If you think this is in error, use --ignore-version-check.\n";
|
|
exit 1;
|
|
} ## end if (version->declare($version...))
|
|
|
|
if ($version_verbatim eq '6.1' && !$opt_ignore_version_check) {
|
|
warning(2,
|
|
"the btrfs-progs version you're using, " . "v$version_verbatim, is known to be missing subvolume uuids.");
|
|
}
|
|
elsif ($version_verbatim eq '5.15' && !$opt_ignore_version_check) {
|
|
warning(2,
|
|
"the btrfs-progs version you're using, " . "v$version_verbatim, is known to report free fs space incorrectly.");
|
|
}
|
|
|
|
if ($< != 0 && !$opt_ignore_root_check) {
|
|
print STDERR "FATAL: you must be root to use this command\n";
|
|
print STDERR "If you think this is in error, use --ignore-root-check\n";
|
|
exit 1;
|
|
}
|
|
|
|
# get moutpoint list, we'll need it several times in the script
|
|
my @procmounts;
|
|
my %mphash;
|
|
open(my $procfd, '<', '/proc/mounts') or die("Couldn't open /proc/mounts: $!");
|
|
while (<$procfd>) {
|
|
if (m{^(\S+)\s+(\S+)\s+(\S+)\s+(\S+)}) {
|
|
push @procmounts,
|
|
{
|
|
dev => $1,
|
|
mp => $2,
|
|
fstype => $3,
|
|
options => $4,
|
|
};
|
|
$mphash{$2} = 1;
|
|
} ## end if (m{^(\S+)\s+(\S+)\s+(\S+)\s+(\S+)})
|
|
} ## end while (<$procfd>)
|
|
close($procfd);
|
|
|
|
# get passed mountpoints
|
|
my @mountPoints = @ARGV;
|
|
|
|
# ensure these (if any) are mountpoints
|
|
foreach my $mp (@mountPoints) {
|
|
# canonicalize
|
|
$mp = link2real($mp);
|
|
|
|
# if not a mp, find a parent that is
|
|
while (1) {
|
|
$mp ||= '/';
|
|
my $ismp = 0;
|
|
foreach (@procmounts) {
|
|
next if ($_->{mp} ne $mp);
|
|
$ismp = 1;
|
|
last;
|
|
}
|
|
if (!$ismp) {
|
|
next if ($mp =~ s{/[^/]+$}{});
|
|
last;
|
|
}
|
|
last;
|
|
} ## end while (1)
|
|
|
|
debug("done, mp is: $mp");
|
|
} ## end foreach my $mp (@mountPoints)
|
|
|
|
# get filesystems list
|
|
|
|
=comment
|
|
# btrfs filesystem show
|
|
Label: 'beurre' uuid: 010705d8-430f-4f5b-9315-12df40677e97
|
|
Total devices 4 FS bytes used 18.23MiB
|
|
devid 1 size 250.00MiB used 176.00MiB path /dev/loop1
|
|
devid 2 size 250.00MiB used 164.00MiB path /dev/loop2
|
|
devid 3 size 250.00MiB used 164.00MiB path /dev/loop3
|
|
devid 4 size 250.00MiB used 164.00MiB path /dev/loop4
|
|
=cut
|
|
|
|
# if no mountpoints specified, use undef to run a 'btrfs fi show' once with no params (all fs)
|
|
@mountPoints = (undef) if !@mountPoints;
|
|
|
|
my @fishow = ();
|
|
foreach my $mp (@mountPoints) {
|
|
$cmd = run_cmd(silent_stderr => 1, cmd => [qw{ btrfs filesystem show --raw }, defined $mp ? $mp : ()]);
|
|
if (!@{$cmd->{stdout}} || $cmd->{status}) {
|
|
$cmd = run_cmd(fatal => 1, cmd => [qw{ btrfs filesystem show }, defined $mp ? $mp : ()]);
|
|
}
|
|
push @fishow, @{$cmd->{stdout}} if $cmd->{stdout};
|
|
} ## end foreach my $mp (@mountPoints)
|
|
|
|
my ($label, $fuuid, %filesystems);
|
|
foreach (@fishow) {
|
|
if (/^Label:\s+(\S+)\s+uuid:\s+([0-9a-f-]+)/) {
|
|
$label = $1;
|
|
$fuuid = $2;
|
|
|
|
# btrfs-progs v3.14+ enquote the label
|
|
if ($label =~ /^'(.+)'$/) {
|
|
$label = $1;
|
|
}
|
|
if ($label eq 'none') {
|
|
|
|
# use the beggining of the uuid instead
|
|
$label = substr($2, 0, 8);
|
|
}
|
|
} ## end if (/^Label:\s+(\S+)\s+uuid:\s+([0-9a-f-]+)/)
|
|
if (defined $fuuid and m{devid\s+(\d+)\s+size\s+(\S+).+path\s+(\S+)}) {
|
|
my ($devid, $size, $dev) = ($1, human2raw($2), $3);
|
|
if (not exists $filesystems{$fuuid}) {
|
|
$filesystems{$fuuid} = {uuid => $fuuid, label => $label, devices => [], devinfo => {}};
|
|
}
|
|
# btrfs-progs v5.10.1 bug workaround: "dm-X" instead of "/dev/dm-X"
|
|
if ($dev && $dev =~ m{^dm-}) {
|
|
debug("Applying workaround $dev => /dev/$dev");
|
|
$dev = "/dev/$dev";
|
|
}
|
|
if (-l $dev) {
|
|
$dev = link2real($dev);
|
|
}
|
|
push @{$filesystems{$fuuid}{'devices'}}, $dev;
|
|
$filesystems{$fuuid}{'devinfo'}{$dev} = {
|
|
devid => $devid,
|
|
size => $size
|
|
};
|
|
} ## end if (defined $fuuid and...)
|
|
} ## end foreach (@fishow)
|
|
debug("FILESYSTEMS HASH DUMP 1:", Dumper \%filesystems);
|
|
|
|
if (!%filesystems) {
|
|
print "No btrfs filesystem found.\n";
|
|
exit 0;
|
|
}
|
|
|
|
# now look for the mountpoints
|
|
|
|
my %dev2mp;
|
|
my %volid2mp;
|
|
foreach my $line (@procmounts) {
|
|
|
|
# fix for /dev/mapper/stuff being a sylink to ../dm-xxx
|
|
next if $line->{fstype} ne 'btrfs';
|
|
my $subvolid = 0;
|
|
($subvolid) = $line->{options} =~ /subvolid=(\d+)/;
|
|
debug(">> mounts item [$line->{dev}] subvolid[$subvolid] mounted on $line->{mp}");
|
|
|
|
# ||=: we might have bind mounts and such, just take the first occurence
|
|
if ($line->{options} =~ /subvolid=(\d+)/) {
|
|
$dev2mp{$line->{dev}} ||= $line->{mp};
|
|
$volid2mp{$line->{dev}}{$subvolid} ||= $line->{mp};
|
|
}
|
|
if (-l $line->{dev}) {
|
|
my $real = link2real($line->{dev});
|
|
$dev2mp{$real} ||= $line->{mp};
|
|
$volid2mp{$real}{$subvolid} ||= $line->{mp};
|
|
}
|
|
} ## end foreach my $line (@procmounts)
|
|
|
|
foreach my $fuuid (keys %filesystems) {
|
|
foreach my $dev (@{$filesystems{$fuuid}{'devices'} || []}) {
|
|
if (exists $dev2mp{$dev}) {
|
|
$filesystems{$fuuid}{'mountpoint'} = $dev2mp{$dev};
|
|
$filesystems{$fuuid}{'volmp'} = $volid2mp{$dev};
|
|
last;
|
|
}
|
|
} ## end foreach my $dev (@{$filesystems...})
|
|
} ## end foreach my $fuuid (keys %filesystems)
|
|
|
|
debug("FILESYSTEMS HASH DUMP 2:", Dumper \%filesystems);
|
|
|
|
# now, for each filesystem we found, let's dig:
|
|
|
|
my %vol;
|
|
foreach my $fuuid (keys %filesystems) {
|
|
my $mp = $filesystems{$fuuid}{'mountpoint'};
|
|
defined $mp or next;
|
|
-d $mp or next;
|
|
|
|
$cmd = run_cmd(silent_stderr => 1, cmd => [qw{ btrfs filesystem usage --raw }, $mp]);
|
|
if (!@{$cmd->{stdout}} || $cmd->{status}) {
|
|
$cmd = run_cmd(fatal => 1, cmd => [qw{ btrfs filesystem usage }, $mp]);
|
|
}
|
|
my ($seenUnallocated, %devFree, $profile, $mprofile);
|
|
my ($total, $fssize, $used, $freeEstimated) = (0, 0, 0, 0);
|
|
foreach (@{$cmd->{stdout}}) {
|
|
if (/Device\s+size:\s*(\S+)/) {
|
|
$fssize = human2raw($1);
|
|
}
|
|
elsif (/^Data,([^:]+): Size:([^,]+), Used:(\S+)/) {
|
|
|
|
#v3.18: Data,RAID1: Size:9.90TiB, Used:9.61TiB
|
|
#v3.19+: Data,RAID1: Size:10881302659072, Used:10569277333504
|
|
$profile = lc($1);
|
|
$total += human2raw($2);
|
|
$used += human2raw($3);
|
|
} ## end elsif (/^Data,([^:]+): Size:([^,]+), Used:(\S+)/)
|
|
elsif (/^Metadata,([^:]+): Size:([^,]+), Used:(\S+)/) {
|
|
$mprofile = lc($1);
|
|
}
|
|
elsif (/Free\s*\(estimated\)\s*:\s*(\S+)/) {
|
|
|
|
#Free (estimated): 405441961984 (min: 405441961984)
|
|
#Free (estimated): 377.60GiB (min: 377.60GiB)
|
|
$freeEstimated = human2raw($1);
|
|
} ## end elsif (/Free\s*\(estimated\)\s*:\s*(\S+)/)
|
|
|
|
if (m{^Unallocated:}) {
|
|
$seenUnallocated = 1;
|
|
}
|
|
elsif ($seenUnallocated && m{^\s*(/\S+)\s+(\d+)\s*$}) {
|
|
$devFree{$1} = human2raw($2) + 0;
|
|
}
|
|
} ## end foreach (@{$cmd->{stdout}})
|
|
|
|
$vol{$fuuid}{df} = {
|
|
id => FAKE_ID_DF,
|
|
path => $filesystems{$fuuid}{label},
|
|
gen => 0,
|
|
cgen => 0,
|
|
parent => '-',
|
|
top => '-', # top_level
|
|
uuid => $fuuid,
|
|
puuid => PARENT_UUID_DF, # parent_uuid
|
|
ruuid => '-', # received_uuid
|
|
type => 'fs',
|
|
mode => 'rw',
|
|
rfer => '-',
|
|
excl => $used,
|
|
free => $total - $used,
|
|
fssize => $fssize,
|
|
};
|
|
debug( "df for $fuuid ("
|
|
. $filesystems{$fuuid}{label}
|
|
. "), excl=$used, free="
|
|
. ($total - $used)
|
|
. ", fssize=$fssize");
|
|
|
|
# cmdline override
|
|
$profile = $opt_profile if defined $opt_profile;
|
|
|
|
if (!$profile) {
|
|
warning(2, "No profile found, assuming single");
|
|
$profile = "single";
|
|
}
|
|
|
|
$vol{$fuuid}{df}{profile} = $profile;
|
|
$vol{$fuuid}{df}{mprofile} = $mprofile;
|
|
|
|
my $computed = compute_allocatable_for_profile($profile, $vol{$fuuid}{df}{free}, \%devFree);
|
|
$vol{$fuuid}{df}{free} = $computed->{allocatable};
|
|
$vol{$fuuid}{df}{unallocatable} = $computed->{unallocatable};
|
|
|
|
# also compute total allocatable size if FS fs empty
|
|
my %devSize;
|
|
foreach my $dev (@{$filesystems{$fuuid}{devices}}) {
|
|
$devSize{$dev} = $filesystems{$fuuid}{devinfo}{$dev}{size};
|
|
}
|
|
$computed = compute_allocatable_for_profile($profile, 0, \%devSize);
|
|
$vol{$fuuid}{df}{fssize} = $computed->{allocatable};
|
|
|
|
next if $opt_free_space;
|
|
|
|
# cvol btrfs sub list
|
|
$cmd = run_cmd(silent_stderr => 1, cmd => [qw{ btrfs subvolume list -pacguq }, $mp]);
|
|
|
|
# ID 3332 gen 81668 cgen 2039 parent 0 top level 0 parent_uuid 9faf..17d4 uuid 20b7..5b61 path <FS_TREE>/DELETED
|
|
# ID 1911 gen 81668 cgen 929 parent 5 top level 5 parent_uuid - uuid aec0705e-6cae-a941-854c-d95e0a36ba2c path main
|
|
foreach (@{$cmd->{stdout}}) {
|
|
my $vuuid = undef;
|
|
if (/(\s|^)uuid ([0-9a-f-]+)/) {
|
|
$vuuid = $2;
|
|
if ($vuuid eq '-') {
|
|
|
|
# old btrfs kernel, recent btrfsprogs
|
|
m{ID (\d+)} and $vuuid = $1;
|
|
}
|
|
$vol{$fuuid}{$vuuid}{uuid} = $vuuid;
|
|
} ## end if (/(\s|^)uuid ([0-9a-f-]+)/)
|
|
elsif (/(\s|^)ID (\d+)/) {
|
|
|
|
# old btrfsprogs
|
|
$vuuid = $2;
|
|
$vol{$fuuid}{$vuuid}{uuid} = $vuuid;
|
|
} ## end elsif (/(\s|^)ID (\d+)/)
|
|
else {
|
|
next;
|
|
}
|
|
|
|
# ID 257 gen 17 cgen 11 parent 5 top level 5 parent_uuid - received_uuid - uuid 9bc4..fd75 path sub1 with spaces
|
|
$vol{$fuuid}{$vuuid}{puuid} = PARENT_UUID_NONE; # old btrfsprogs don't have puuid, set a sane default
|
|
/(\s|^)ID (\d+)/ and $vol{$fuuid}{$vuuid}{id} = $2;
|
|
/(\s|^)gen (\d+)/ and $vol{$fuuid}{$vuuid}{gen} = $2;
|
|
/(\s|^)cgen (\d+)/ and $vol{$fuuid}{$vuuid}{cgen} = $2;
|
|
/(\s|^)parent (\d+)/ and $vol{$fuuid}{$vuuid}{parent} = $2;
|
|
/(\s|^)top level (\d+)/ and $vol{$fuuid}{$vuuid}{top} = $2;
|
|
/(\s|^)parent_uuid (\S+)/ and $vol{$fuuid}{$vuuid}{puuid} = $2;
|
|
/(\s|^)received_uuid (\S+)/ and $vol{$fuuid}{$vuuid}{ruuid} = $2;
|
|
/(\s|^)path (.+)/ and $vol{$fuuid}{$vuuid}{path} = $2;
|
|
$vol{$fuuid}{$vuuid}{path} =~ s/^<FS_TREE>\///;
|
|
$vol{$fuuid}{$vuuid}{type} = 'subvol'; # by default, will be overriden below if applicable
|
|
$vol{$fuuid}{$vuuid}{mode} = 'rw'; # by default, will be overriden below if applicable
|
|
$vol{$fuuid}{$vuuid}{rfer} = 0;
|
|
$vol{$fuuid}{$vuuid}{excl} = 0;
|
|
$vol{$fuuid}{$vuuid}{mp} = $filesystems{$fuuid}{volmp}{$vol{$fuuid}{$vuuid}{id}};
|
|
} ## end foreach (@{$cmd->{stdout}})
|
|
|
|
# now, list only snapshots, we also get their otime for free
|
|
$cmd = run_cmd(cmd => [qw{ btrfs subvolume list -us }, $mp]);
|
|
|
|
# ID 694 gen 30002591 cgen 30002589 top level 5 otime 2022-01-02 14:37:14 path test backup2 with spaces
|
|
foreach (@{$cmd->{stdout}}) {
|
|
my ($found, $otime);
|
|
/(\s|^)uuid ([0-9a-f-]+)/ and exists $vol{$fuuid}{$2} and $found = $2;
|
|
/(\s|^)ID ([0-9]+)/ and exists $vol{$fuuid}{$2} and $found = $2;
|
|
/(\s|^)otime (\S+ \S+)/ and $otime = $2;
|
|
if (defined $found) {
|
|
if ($opt_hide_snapshots) {
|
|
delete $vol{$fuuid}{$found};
|
|
}
|
|
else {
|
|
$vol{$fuuid}{$found}{type} = 'snap';
|
|
$vol{$fuuid}{$found}{otime} = $otime if $otime;
|
|
}
|
|
} ## end if (defined $found)
|
|
} ## end foreach (@{$cmd->{stdout}})
|
|
|
|
# then, list readonly snapshots
|
|
$cmd = run_cmd(cmd => [qw{ btrfs subvolume list -ur }, $mp]);
|
|
foreach (@{$cmd->{stdout}}) {
|
|
/(\s|^)uuid ([0-9a-f-]+)/ and exists $vol{$fuuid}{$2} and $vol{$fuuid}{$2}{mode} = 'ro';
|
|
/(\s|^)ID ([0-9]+)/ and exists $vol{$fuuid}{$2} and $vol{$fuuid}{$2}{mode} = 'ro';
|
|
}
|
|
debug("VOL{FUUID=$fuuid} DUMP:", Dumper \$vol{$fuuid});
|
|
} ## end foreach my $fuuid (keys %filesystems)
|
|
|
|
# get quota stuff
|
|
|
|
# v3.18 (no --raw)
|
|
|
|
=comment
|
|
WARNING: Qgroup data inconsistent, rescan recommended
|
|
qgroupid rfer excl max_rfer max_excl parent child
|
|
-------- ---- ---- -------- -------- ------ -----
|
|
0/5 7.99MiB 7.99MiB 0.00B 0.00B --- ---
|
|
0/257 10.02MiB 10.01MiB 0.00B 0.00B --- ---
|
|
=cut
|
|
|
|
# v3.19+ has --raw, and additionally, since v4.1, we get 'none' instead of 0:
|
|
|
|
=comment
|
|
qgroupid rfer excl max_rfer max_excl parent child
|
|
-------- ---- ---- -------- -------- ------ -----
|
|
0/5 9848498 8015121 none none --- ---
|
|
0/257 10213513 10131212 none none --- ---
|
|
=cut
|
|
|
|
foreach my $fuuid (keys %filesystems) {
|
|
my $mp = $filesystems{$fuuid}{'mountpoint'};
|
|
defined $mp or next;
|
|
-d $mp or next;
|
|
next if $opt_free_space;
|
|
|
|
# let's still fill the info for the main volume
|
|
$vol{$fuuid}{5} = {
|
|
id => 5,
|
|
path => "[main]",
|
|
gen => 0,
|
|
cgen => 0,
|
|
parent => '-',
|
|
top => '-',
|
|
uuid => '-', # may be filled below
|
|
puuid => PARENT_UUID_NONE_MAINVOL,
|
|
ruuid => '-',
|
|
type => 'mainvol',
|
|
mode => 'rw',
|
|
mp => $mp,
|
|
};
|
|
|
|
# grab the uuid of the main volume, note that sometimes there is none, and UUID is reported as '-'
|
|
# also get the current geenration, and the gen at creation (which should always be 0)
|
|
$cmd = run_cmd(silent_stderr => 1, cmd => [qw{ btrfs subvolume show -b }, $mp]);
|
|
foreach (@{$cmd->{stdout}}) {
|
|
/^\s*UUID:\s*([0-9a-f-]+)/ and $vol{$fuuid}{5}{uuid} = $1;
|
|
/Generation:\s*(\d+)/ and $vol{$fuuid}{5}{gen} = $1;
|
|
/Gen at creation:\s*(\d+)/ and $vol{$fuuid}{5}{cgen} = $1;
|
|
}
|
|
|
|
$cmd = run_cmd(silent_stderr => 1, cmd => [qw{ btrfs quota rescan -s }, $mp]);
|
|
if ($cmd->{stdout}->[0] && $cmd->{stdout}->[0] =~ /operation running|current key/) {
|
|
warning(1, "a quota rescan is running, size information is not correct yet");
|
|
}
|
|
|
|
$cmd = run_cmd(silent_stderr => 1, cmd => [qw{ btrfs qgroup show -pcre --raw }, $mp]);
|
|
if ($cmd->{status} || !@{$cmd->{stdout}}) {
|
|
|
|
# btrfs-progs v3.18 doesn't support --raw
|
|
$cmd = run_cmd(silent_stderr => 1, cmd => [qw{ btrfs qgroup show -pcre }, $mp]);
|
|
if ($cmd->{status} || !@{$cmd->{stdout}}) {
|
|
warning(1, "to get refer/excl size information, please enable qgroups (btrfs quota enable $mp)");
|
|
$vol{$fuuid}{df}{noquota} = 1;
|
|
}
|
|
} ## end if ($cmd->{status} || ...)
|
|
|
|
foreach (@{$cmd->{stdout}}) {
|
|
if (m{^(\d+)/(\d+)\s+(\S+)\s+(\S+)}) {
|
|
my ($qid, $id, $rfer, $excl) = ($1, $2, human2raw($3), human2raw($4));
|
|
next if $qid != 0; # only check level 0 qgroups (leafs)
|
|
if ($id < 256) {
|
|
if (not exists $vol{$fuuid}{$id}) {
|
|
$vol{$fuuid}{$id} = {
|
|
id => $id,
|
|
path => "[main]",
|
|
gen => 0,
|
|
cgen => 0,
|
|
parent => '-',
|
|
top => '-',
|
|
puuid => PARENT_UUID_NONE_MAINVOL,
|
|
ruuid => '-',
|
|
type => 'mainvol',
|
|
mode => 'rw',
|
|
mp => $filesystems{$fuuid}{volmp}{5},
|
|
};
|
|
} ## end if (not exists $vol{$fuuid...})
|
|
$vol{$fuuid}{$id}{rfer} = $rfer;
|
|
$vol{$fuuid}{$id}{excl} = $excl;
|
|
next;
|
|
} ## end if ($id < 256)
|
|
foreach my $vuuid (keys %{$vol{$fuuid}}) {
|
|
if ($id eq $vol{$fuuid}{$vuuid}{id}) {
|
|
$vol{$fuuid}{$vuuid}{rfer} = $rfer;
|
|
$vol{$fuuid}{$vuuid}{excl} = $excl;
|
|
last;
|
|
}
|
|
} ## end foreach my $vuuid (keys %{$vol...})
|
|
} ## end if (m{^(\d+)/(\d+)\s+(\S+)\s+(\S+)})
|
|
} ## end foreach (@{$cmd->{stdout}})
|
|
} ## end foreach my $fuuid (keys %filesystems)
|
|
debug("VOL HASH DUMP (filesystem uuid - volume uuid - data):", Dumper \%vol);
|
|
|
|
# ok, now, do the magic
|
|
|
|
my @ordered = ();
|
|
my $maxdepth = 0;
|
|
my %seen;
|
|
|
|
sub recursive_add_children_of {
|
|
my %params = @_;
|
|
my $volumes = $params{'volumes'};
|
|
my $depth = $params{'depth'};
|
|
my $parentuuid = $params{'parentuuid'};
|
|
|
|
$depth > $maxdepth and $maxdepth = $depth;
|
|
|
|
foreach my $vuuid (sort { $volumes->{$a}{id} <=> $volumes->{$b}{id} } keys %$volumes) {
|
|
next if $seen{$vuuid}; # not needed, but just in case
|
|
my $vol = $volumes->{$vuuid};
|
|
debug( "..." x ($depth)
|
|
. "parent_uuid=$parentuuid, currently working on id "
|
|
. $vol->{id}
|
|
. " volume_uuid=$vuuid having parent_uuid="
|
|
. $vol->{puuid}
|
|
. " and path-type "
|
|
. $vol->{path} . "-"
|
|
. $vol->{type});
|
|
if ($parentuuid eq $vol->{puuid}) {
|
|
$vol->{depth} = $depth;
|
|
push @ordered, $vol;
|
|
debug("..." x ($depth) . "^^^");
|
|
$seen{$vuuid} = 1;
|
|
recursive_add_children_of(volumes => $volumes, depth => $depth + 1, parentuuid => $vuuid); # unless $parentuuid eq '-';
|
|
} ## end if ($parentuuid eq $vol...)
|
|
} ## end foreach my $vuuid (sort { $volumes...})
|
|
return;
|
|
} ## end sub recursive_add_children_of
|
|
|
|
my @orderedAll;
|
|
$opt_deleted ||= 0;
|
|
foreach my $fuuid (sort keys %filesystems) {
|
|
@ordered = ();
|
|
%seen = ();
|
|
$maxdepth = 0;
|
|
my @orphans = ();
|
|
|
|
# first, we want the so-called "df" line, which conveniently has a fake specific parent_uuid
|
|
debug(">>> order df");
|
|
recursive_add_children_of(volumes => $vol{$fuuid}, depth => 0, parentuuid => PARENT_UUID_DF);
|
|
|
|
# then, the builtin main volume (id=5) and all its descendants
|
|
debug(">>> order mainvol");
|
|
recursive_add_children_of(volumes => $vol{$fuuid}, depth => 1, parentuuid => PARENT_UUID_NONE_MAINVOL);
|
|
|
|
# then, all the other top-level volumes (i.e. that have no parent uuid)
|
|
debug(">>> order top level vols");
|
|
recursive_add_children_of(volumes => $vol{$fuuid}, depth => 1, parentuuid => PARENT_UUID_NONE);
|
|
|
|
next if !@ordered;
|
|
|
|
# then, we might still have unseen volumes, which are orphans (they have a parent_uuid)
|
|
# but the parent_uuid no longer exists). get all those in a hash
|
|
|
|
ORPHANS: foreach my $vuuid (keys %{$vol{$fuuid}}) {
|
|
next if $seen{$vuuid};
|
|
push @orphans, $vuuid;
|
|
}
|
|
|
|
# those orphans might however have parents/children between themselves,
|
|
# so find the first one that has no known parent among the other orphans
|
|
foreach my $orphan (sort @orphans) {
|
|
my $no_known_parent = 1;
|
|
foreach my $potential_parent (@orphans) {
|
|
next if $orphan eq $potential_parent; # skip myself
|
|
$no_known_parent = 0 if ($potential_parent eq $vol{$fuuid}{$orphan}{puuid});
|
|
}
|
|
debug(">>> orphan loop on $orphan, no known parent: $no_known_parent");
|
|
if ($no_known_parent == 1) {
|
|
if ($opt_deleted) {
|
|
my $parent_uuid = $vol{$fuuid}{$orphan}{puuid};
|
|
|
|
# craft a ghost parent if asked to
|
|
my $ghost = {
|
|
id => FAKE_ID_GHOST,
|
|
type => 'deleted',
|
|
path => "(deleted)",
|
|
uuid => $parent_uuid,
|
|
depth => 1,
|
|
};
|
|
push @ordered, $ghost;
|
|
$seen{$parent_uuid} = 1;
|
|
debug(">>> added ghost parent $parent_uuid");
|
|
|
|
# and all the ghost' children, if any
|
|
debug(">>> adding children of ghost parent $parent_uuid (we should have at least $orphan)");
|
|
recursive_add_children_of(volumes => $vol{$fuuid}, depth => 2, parentuuid => $parent_uuid);
|
|
} ## end if ($opt_deleted)
|
|
else {
|
|
|
|
# add the orphan ourselves
|
|
push @ordered, $vol{$fuuid}{$orphan};
|
|
$seen{$orphan} = 1;
|
|
$vol{$fuuid}{$orphan}{depth} = 1;
|
|
|
|
# and all the orphans' children, if any
|
|
debug(">>> adding children of orphan $orphan");
|
|
recursive_add_children_of(volumes => $vol{$fuuid}, depth => 2, parentuuid => $orphan);
|
|
} ## end else [ if ($opt_deleted) ]
|
|
} ## end if ($no_known_parent ==...)
|
|
|
|
if ($opt_deleted) {
|
|
|
|
# we have added a new ghost parent, so other orphans might no longer
|
|
# actually be orphans, start again above
|
|
@orphans = ();
|
|
goto ORPHANS;
|
|
} ## end if ($opt_deleted)
|
|
} ## end foreach my $orphan (sort @orphans)
|
|
|
|
# do we still have unseen volumes? (we shouldn't)
|
|
foreach my $vuuid (keys %{$vol{$fuuid}}) {
|
|
next if $seen{$vuuid};
|
|
warning(2, "we shouldn't have orphaned volumne $vuuid");
|
|
push @ordered, $vuuid;
|
|
}
|
|
|
|
push @orderedAll, @ordered;
|
|
} ## end foreach my $fuuid (sort keys...)
|
|
|
|
# this sub returns the length of the longest item of a column or @sortedAll
|
|
# and pushes the header name to @headers
|
|
my @header;
|
|
|
|
sub longest {
|
|
my $headerName = shift;
|
|
my $useDepth = shift; # whether 'depth' should be taken into account
|
|
my $key = shift;
|
|
|
|
# ensure the header name always fits
|
|
my $longest = ($opt_no_header ? 1 : length($headerName));
|
|
push @header, $headerName;
|
|
|
|
# loop through all the items
|
|
foreach my $item (@orderedAll) {
|
|
my $len = ($useDepth ? (($item->{depth} || 0) * $opt_indent) : 0);
|
|
$len += length($item->{$key} || '');
|
|
$longest = $len if $len > $longest;
|
|
}
|
|
|
|
return $longest;
|
|
} ## end sub longest
|
|
|
|
# find the longest path (including leading spaces)
|
|
# note that longest() also pushes the header to @headers
|
|
my $format;
|
|
|
|
# special case for path: if opt_max_name_len is specified,
|
|
# and it is shorter that longest('NAME', 1, 'path'), use it
|
|
# instead
|
|
my $formatpathlen = longest('NAME', 1, 'path');
|
|
if ($opt_max_name_len > 0 && $opt_max_name_len < $formatpathlen) {
|
|
$format = "%-" . $opt_max_name_len . "s ";
|
|
}
|
|
else {
|
|
$format = "%-" . $formatpathlen . "s ";
|
|
}
|
|
|
|
if ($opt_show_id) {
|
|
$format .= "%" . longest('ID', 0, 'id') . "s ";
|
|
}
|
|
if ($opt_show_parent) {
|
|
$format .= "%" . longest('PARENT', 0, 'parent') . "s ";
|
|
}
|
|
if ($opt_show_toplevel) {
|
|
$format .= "%" . longest('TOPLVL', 0, 'top') . "s ";
|
|
}
|
|
if ($opt_show_gen) {
|
|
$format .= "%" . longest('GEN', 0, 'gen') . "s ";
|
|
}
|
|
if ($opt_show_cgen) {
|
|
$format .= "%" . longest('CGEN', 0, 'cgen') . "s ";
|
|
}
|
|
my $uuid_len = ($opt_wide ? 36 : 10);
|
|
if ($opt_show_uuid) {
|
|
$format .= "%${uuid_len}s ";
|
|
push @header, qw{ UUID };
|
|
}
|
|
if ($opt_show_puuid) {
|
|
$format .= "%${uuid_len}s ";
|
|
push @header, qw{ PARENTUUID };
|
|
}
|
|
if ($opt_show_ruuid) {
|
|
$format .= "%${uuid_len}s ";
|
|
push @header, qw{ RCVD_UUID };
|
|
}
|
|
if ($opt_show_otime) {
|
|
$format .= "%20s ";
|
|
push @header, qw{ OTIME };
|
|
}
|
|
$format .= "%" . longest('TYPE', 0, 'type') . "s ";
|
|
|
|
my $pretty_print_size = ($opt_raw ? 16 : 7);
|
|
my $noquota = $vol{$fuuid}{df}{noquota} || $opt_free_space;
|
|
if (!$noquota) {
|
|
$format .= "%s%${pretty_print_size}s%s%1s%s ";
|
|
push @header, '', 'REFE', 'R', '', '';
|
|
push @header, '', 'EXCL', '', '', '', 'MOUNTPOINT';
|
|
}
|
|
else {
|
|
push @header, '', 'EXC', 'L', '', '', 'MOUNTPOINT';
|
|
}
|
|
|
|
$format .= "%s%${pretty_print_size}s%s%1s%s %s\n";
|
|
|
|
printf $format, @header if !$opt_no_header;
|
|
|
|
foreach my $line (@orderedAll) {
|
|
next if ($opt_hide_snapshots and $line->{type} eq 'snap');
|
|
next if ($opt_only_snapshots and $line->{type} ne 'snap');
|
|
$line->{rfer} ||= 0;
|
|
$line->{excl} ||= 0;
|
|
my $type = $line->{type};
|
|
if ($opt_snap_min_used) {
|
|
next if ($type eq 'snap' && $line->{rfer} =~ /^\d+$/ && $line->{excl} < $opt_snap_min_used);
|
|
}
|
|
if ($opt_snap_max_used) {
|
|
next if ($type eq 'snap' && $line->{rfer} =~ /^\d+$/ && $line->{excl} > $opt_snap_max_used);
|
|
}
|
|
$type = "ro$type" if ($line->{mode} && $line->{mode} eq 'ro');
|
|
my $extra = '';
|
|
if (exists $line->{free}) {
|
|
my $displayProfile = $line->{profile};
|
|
$displayProfile .= "/" . $line->{mprofile} if ($line->{profile} ne $line->{mprofile});
|
|
if (!$opt_used) {
|
|
$extra = sprintf(
|
|
"(%s, %s/%s free, %.02f%%",
|
|
$displayProfile,
|
|
pretty_print_str($line->{free}, 2),
|
|
pretty_print_str($line->{fssize}, 2),
|
|
$line->{free} * 100 / $line->{fssize}
|
|
);
|
|
} ## end if (!$opt_used)
|
|
else {
|
|
my $used = $line->{fssize} - $line->{free};
|
|
$extra = sprintf(
|
|
"(%s, %s/%s used, %.02f%%",
|
|
$displayProfile,
|
|
pretty_print_str($used, 2),
|
|
pretty_print_str($line->{fssize}, 2),
|
|
$used * 100 / $line->{fssize}
|
|
);
|
|
} ## end else [ if (!$opt_used) ]
|
|
if ($line->{unallocatable} && $line->{unallocatable} > MiB) {
|
|
$extra .= sprintf(', %s unallocatable', pretty_print_str($line->{unallocatable}, 2));
|
|
}
|
|
$extra .= ')';
|
|
} ## end if (exists $line->{free...})
|
|
elsif (defined $line->{mp}) {
|
|
$extra = $line->{mp};
|
|
}
|
|
$line->{depth} ||= 0;
|
|
$line->{id} ||= 0;
|
|
|
|
if (!$opt_wide) {
|
|
foreach my $key (qw{ uuid puuid ruuid }) {
|
|
next if !$line->{$key};
|
|
if ($line->{$key} =~ m{^(....).+(....)$}) {
|
|
$line->{$key} = "$1..$2";
|
|
}
|
|
} ## end foreach my $key (qw{ uuid puuid ruuid })
|
|
} ## end if (!$opt_wide)
|
|
|
|
# replace our internal id==-1 by -
|
|
$line->{id} =~ /^\d+$/ or $line->{id} = '-';
|
|
|
|
# replace our internal '*' and '+' by '-'
|
|
$line->{puuid} = '-' if ($line->{'puuid'} && length($line->{puuid}) == 1);
|
|
|
|
# shorten path if --max-name-len is specified
|
|
my $pathprefix = " " x ($line->{depth} * $opt_indent);
|
|
my $pathdisplay = $line->{path};
|
|
if ($opt_max_name_len > 0 && length($line->{path}) > $opt_max_name_len) {
|
|
my $remaininglen = $opt_max_name_len - length($pathprefix) - 4;
|
|
|
|
# if we exceed the available space just with the indentation, fallback
|
|
# to limit the indentation and just display '[..]' for the subvol name
|
|
if ($remaininglen <= 4) {
|
|
$pathprefix = " " x ($opt_max_name_len - 4);
|
|
$pathdisplay = '[..]';
|
|
}
|
|
else {
|
|
$pathdisplay = substr($line->{'path'}, 0, $remaininglen / 2) . '[..]'
|
|
. substr($line->{'path'}, length($line->{'path'}) - $remaininglen / 2);
|
|
}
|
|
} ## end if ($opt_max_name_len ...)
|
|
|
|
my @fields = $pathprefix . $pathdisplay;
|
|
push @fields, $line->{id} || '-' if $opt_show_id;
|
|
push @fields, $line->{parent} || '-' if $opt_show_parent;
|
|
push @fields, $line->{top} || '-' if $opt_show_toplevel;
|
|
push @fields, $line->{gen} || '-' if $opt_show_gen;
|
|
push @fields, $line->{cgen} || '-' if $opt_show_cgen;
|
|
push @fields, $line->{uuid} || '-' if $opt_show_uuid;
|
|
push @fields, $line->{puuid} || '-' if $opt_show_puuid;
|
|
push @fields, $line->{ruuid} || '-' if $opt_show_ruuid;
|
|
push @fields, $line->{otime} || '-' if $opt_show_otime;
|
|
push @fields, $type;
|
|
push @fields, pretty_print($line->{rfer}, 1) if !$noquota;
|
|
push @fields, pretty_print($line->{excl}, 1), $extra;
|
|
printf $format, @fields;
|
|
} ## end foreach my $line (@orderedAll)
|