#!/usr/bin/perl
#
# $Id: prtcheckperms,v 1.1 2023/09/07 18:51:46 jmq Exp $

use strict;
use warnings;

my %wrongmode; # hash from suspicious file to the port(s) that claim to own it

foreach (split('\n', `prt-get printf "%i:%p:%n\n"`)) {
    my ($isinst, $repo, $name) = split(':', $_, 3);
    next if ($isinst eq "no");
    open (my $fp,"$repo/$name/.footprint") or die "no footprint for $repo/$name";
    while(<$fp>) {
      my ($Emod,$Eown,$file) = split(/\t| -> /, $_, 3);
      chomp($file); $file =~ s/\/$//;
      next if (! -e "/$file"); # this case is handled by prtcheckmissing

      # there's a file on disk, so inspect its owner and perms
      my @stat = (-l "/$file") ? lstat("/$file") : stat("/$file");
      my $Fown = getpwuid($stat[4]) . "/" . getgrgid($stat[5]);
      my $Fmod = mode_to_string($stat[2]);
      $wrongmode{$file} .= " $name" if (($Eown ne $Fown) or ($Emod ne $Fmod));
    }
    close($fp);
}

# final report
next if (not %wrongmode);
print map "/$_  (from$wrongmode{$_})\n", sort keys %wrongmode; 

# inlined from Stat::lsMode in order to avoid an extra dependency
# (https://metacpan.org/pod/Stat::lsMode)
sub mode_to_string {
  my ($mode) = @_;
  my @perms = qw(--- --x -w- -wx r-- r-x rw- rwx);
  my @ftype = qw(. p c ? d ? b ? - ? l ? s D ? ?);
  $ftype[0] = '';
  my @str_mode = @perms[($mode&0700)>>6, ($mode&0070)>>3, $mode&0007];
  my $ftype = $ftype[($mode & 0170000)>>12];

  my $setids = ($mode & 07000)>>9;
  if ($setids) {
    if ($setids & 01) { # Sticky bit
      $str_mode[2] =~ s/([-x])$/$1 eq 'x' ? 't' : 'T'/e;
    }
    if ($setids & 02) { # Setgid bit
      $str_mode[1] =~ s/([-x])$/$1 eq 'x' ? 's' : 'S'/e;
    }
    if ($setids & 04) { # Setuid bit
      $str_mode[0] =~ s/([-x])$/$1 eq 'x' ? 's' : 'S'/e;
    }
  }
  return join '', $ftype, @str_mode;
}
