lib/PublicInbox/NDC_PP.pm

   1 # Copyright (C) 2020 all contributors <meta@public-inbox.org>
   2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   3
   4 # Pure-perl class for Linux non-Inline::C users to disable COW for btrfs
   5 package PublicInbox::NDC_PP;
   6 use strict;
   7 use v5.10.1;
   8
   9 sub nodatacow_dir ($) {
  10         my ($path) = @_;
  11         open my $mh, '<', '/proc/self/mounts' or return;
  12         for (grep(/ btrfs /, <$mh>)) {
  13                 my (undef, $mnt_path, $type) = split(/ /);
  14                 next if $type ne 'btrfs'; # in case of false-positive from grep
  15
  16                 # weird chars are escaped as octal
  17                 $mnt_path =~ s/\\(0[0-9]{2})/chr(oct($1))/egs;
  18                 $mnt_path .= '/' unless $mnt_path =~ m!/\z!;
  19                 if (index($path, $mnt_path) == 0) {
  20                         # error goes to stderr, but non-fatal for us
  21                         system('chattr', '+C', $path);
  22                         last;
  23                 }
  24         }
  25 }
  26
  27 sub nodatacow_fd ($) {
  28         my ($fd) = @_;
  29         return if $^O ne 'linux';
  30         defined(my $path = readlink("/proc/self/fd/$fd")) or return;
  31         nodatacow_dir($path);
  32 }
  33
  34 1;