#!/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)