From 35fc5c5a1ecbbdf6b6aa75fd0fbd5c5122f49c04 Mon Sep 17 00:00:00 2001 From: Alexander Szczepanski Date: Sat, 2 Nov 2024 18:56:47 +0100 Subject: [PATCH] desktop-2024-11-02-18-56-47 --- btrfs-list | 1207 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1207 insertions(+) create mode 100755 btrfs-list diff --git a/btrfs-list b/btrfs-list new file mode 100755 index 0000000..6f5ec6a --- /dev/null +++ b/btrfs-list @@ -0,0 +1,1207 @@ +#!/usr/bin/env 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 /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/^\///; + $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)