💾 Archived View for thrig.me › blog › 2023 › 07 › 27 › mirror-permissions.pl captured on 2024-07-09 at 01:18:59.

View Raw

More Information

⬅️ Previous capture (2023-09-28)

-=-=-=-=-=-=-

#!/usr/bin/env perl
# mirror-permissions - (try to) copy the permissions and ownership
# from the first file given to the rest. this could easily be
# written in C for better efficiency (or sh, for less efficiency)
use strict;
use warnings;
die "Usage: mirror-permissions source-from target ..\n"
  unless @ARGV > 1;

my $source = shift;
my @sattr  = ( stat($source) )[ 2, 4, 5 ]
  or die "cannot stat '$source': $!\n";
$sattr[0] &= 07777;    # filter off the file type

for my $target (@ARGV) {
    my @tattr = ( stat($target) )[ 2, 4, 5, 8, 9 ]
      or die "cannot stat '$target': $!\n";

    my $changed = chown @sattr[ 1, 2 ], $target;
    die "chown failed '$target': $!\n" if $changed != 1;

    $changed = chmod $sattr[0], $target;
    if ( $changed != 1 ) {
        # whoops, try to restore the original
        chown @tattr[ 1, 2 ], $target;
        utime @tattr[ 3, 4 ], $target;
        die "chmod failed '$target': $!\n";
    }
}